From 3260749d369d3466c345d40a8b2189c32c8c1b60 Mon Sep 17 00:00:00 2001
From: Alexander Sulfrian
Date: Mon, 7 Nov 2011 15:26:44 +0100
Subject: removed pascal code
---
src/base/TextGL.pas | 211 -
src/base/UBeatTimer.pas | 170 -
src/base/UCatCovers.pas | 214 -
src/base/UCommandLine.pas | 345 -
src/base/UCommon.pas | 584 --
src/base/UConfig.pas | 232 -
src/base/UCovers.pas | 459 -
src/base/UDLLManager.pas | 293 -
src/base/UDataBase.pas | 614 --
src/base/UDraw.pas | 1408 ---
src/base/UEditorLyrics.pas | 259 -
src/base/UFiles.pas | 212 -
src/base/UFilesystem.pas | 692 --
src/base/UFont.pas | 2798 ------
src/base/UGraphic.pas | 823 --
src/base/UGraphicClasses.pas | 720 --
src/base/UIni.pas | 1219 ---
src/base/UJoystick.pas | 312 -
src/base/ULog.pas | 441 -
src/base/ULyrics.pas | 726 --
src/base/UMain.pas | 569 --
src/base/UMusic.pas | 1139 ---
src/base/UNote.pas | 591 --
src/base/UParty.pas | 388 -
src/base/UPathUtils.pas | 196 -
src/base/UPlatform.pas | 135 -
src/base/UPlatformLinux.pas | 149 -
src/base/UPlatformMacOSX.pas | 279 -
src/base/UPlatformWindows.pas | 128 -
src/base/UPlaylist.pas | 520 --
src/base/URecord.pas | 777 --
src/base/USingScores.pas | 1122 ---
src/base/USkins.pas | 220 -
src/base/USong.pas | 1348 ---
src/base/USongs.pas | 845 --
src/base/UTextEncoding.pas | 247 -
src/base/UTexture.pas | 547 --
src/base/UThemes.pas | 2397 -----
src/base/UUnicodeUtils.pas | 670 --
src/base/UXMLSong.pas | 623 --
src/lib/FreeImage/FreeBitmap.pas | 1742 ----
src/lib/FreeImage/FreeImage.pas | 771 --
src/lib/JEDI-SDL/OpenGL/Pas/geometry.pas | 1994 ----
src/lib/JEDI-SDL/OpenGL/Pas/gl.pas | 2301 -----
src/lib/JEDI-SDL/OpenGL/Pas/glext.pas | 9579 --------------------
src/lib/JEDI-SDL/OpenGL/Pas/glu.pas | 582 --
src/lib/JEDI-SDL/OpenGL/Pas/glut.pas | 688 --
src/lib/JEDI-SDL/OpenGL/Pas/glx.pas | 279 -
src/lib/JEDI-SDL/SDL/Pas/libxmlparser.pas | 2688 ------
src/lib/JEDI-SDL/SDL/Pas/logger.pas | 189 -
src/lib/JEDI-SDL/SDL/Pas/moduleloader.pas | 320 -
.../JEDI-SDL/SDL/Pas/registryuserpreferences.pas | 229 -
src/lib/JEDI-SDL/SDL/Pas/sdl.pas | 4332 ---------
src/lib/JEDI-SDL/SDL/Pas/sdl_cpuinfo.pas | 155 -
src/lib/JEDI-SDL/SDL/Pas/sdlgameinterface.pas | 202 -
src/lib/JEDI-SDL/SDL/Pas/sdli386utils.pas | 5236 -----------
src/lib/JEDI-SDL/SDL/Pas/sdlinput.pas | 923 --
src/lib/JEDI-SDL/SDL/Pas/sdlstreams.pas | 216 -
src/lib/JEDI-SDL/SDL/Pas/sdlticks.pas | 197 -
src/lib/JEDI-SDL/SDL/Pas/sdlutils.pas | 4363 ---------
src/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas | 566 --
src/lib/JEDI-SDL/SDL/Pas/userpreferences.pas | 159 -
src/lib/JEDI-SDL/SDL_Image/Pas/sdl_image.pas | 350 -
src/lib/SQLite/SQLite3.pas | 253 -
src/lib/SQLite/SQLiteTable3.pas | 1500 ---
src/lib/SQLite/example/uTestSqlite.pas | 233 -
src/lib/TntUnicodeControls/TntClasses.pas | 1799 ----
src/lib/TntUnicodeControls/TntFormatStrUtils.pas | 521 --
src/lib/TntUnicodeControls/TntSysUtils.pas | 1753 ----
src/lib/TntUnicodeControls/TntSystem.pas | 1427 ---
src/lib/TntUnicodeControls/TntWideStrUtils.pas | 455 -
src/lib/TntUnicodeControls/TntWideStrings.pas | 846 --
src/lib/TntUnicodeControls/TntWindows.pas | 1501 ---
src/lib/bass/delphi/bass.pas | 900 --
src/lib/collections/CollArray.pas | 183 -
src/lib/collections/CollHash.pas | 1497 ---
src/lib/collections/CollLibrary.pas | 131 -
src/lib/collections/CollList.pas | 270 -
src/lib/collections/CollPArray.pas | 689 --
src/lib/collections/CollWrappers.pas | 876 --
src/lib/collections/Collections.pas | 5318 -----------
src/lib/ctypes/ctypes.pas | 72 -
src/lib/ffmpeg/avcodec.pas | 4533 ---------
src/lib/ffmpeg/avformat.pas | 1750 ----
src/lib/ffmpeg/avio.pas | 590 --
src/lib/ffmpeg/avutil.pas | 420 -
src/lib/ffmpeg/mathematics.pas | 104 -
src/lib/ffmpeg/opt.pas | 272 -
src/lib/ffmpeg/rational.pas | 179 -
src/lib/ffmpeg/swscale.pas | 355 -
src/lib/fft/UFFT.pas | 602 --
src/lib/freetype/demo/nehe/UFreeType.pas | 326 -
src/lib/freetype/freetype.pas | 1845 ----
src/lib/libpng/png.pas | 974 --
src/lib/midi/MidiFile.pas | 968 --
src/lib/midi/MidiScope.pas | 198 -
src/lib/midi/Midicons.pas | 47 -
src/lib/midi/Midiin.pas | 727 --
src/lib/midi/Midiout.pas | 619 --
src/lib/midi/demo/MidiTest.pas | 249 -
src/lib/other/DirWatch.pas | 345 -
src/lib/other/WinAllocation.pas | 101 -
src/lib/pcre/pcre.pas | 852 --
src/lib/portaudio/portaudio.pas | 1160 ---
src/lib/portmixer/portmixer.pas | 149 -
src/lib/projectM/projectM.pas | 232 -
src/lib/samplerate/samplerate.pas | 199 -
src/lib/zlib/zlib.pas | 215 -
src/macosx/PseudoThread.pas | 75 -
src/media/UAudioConverter.pas | 483 -
src/media/UAudioCore_Bass.pas | 160 -
src/media/UAudioCore_Portaudio.pas | 281 -
src/media/UAudioDecoder_Bass.pas | 278 -
src/media/UAudioDecoder_FFmpeg.pas | 1141 ---
src/media/UAudioInput_Bass.pas | 510 --
src/media/UAudioInput_Portaudio.pas | 495 -
src/media/UAudioPlaybackBase.pas | 318 -
src/media/UAudioPlayback_Bass.pas | 758 --
src/media/UAudioPlayback_Portaudio.pas | 385 -
src/media/UAudioPlayback_SDL.pas | 182 -
src/media/UAudioPlayback_SoftMixer.pas | 1154 ---
src/media/UMediaCore_FFmpeg.pas | 550 --
src/media/UMediaCore_SDL.pas | 63 -
src/media/UMedia_dummy.pas | 269 -
src/media/UVideo.pas | 966 --
src/media/UVisualizer.pas | 552 --
src/menu/UDrawTexture.pas | 139 -
src/menu/UMenu.pas | 1762 ----
src/menu/UMenuBackgroundFade.pas | 176 -
src/menu/UMenuBackgroundTexture.pas | 126 -
src/menu/UMenuBackgroundVideo.pas | 203 -
src/menu/UMenuButton.pas | 647 --
src/menu/UMenuButtonCollection.pas | 101 -
src/menu/UMenuEqualizer.pas | 320 -
src/menu/UMenuInteract.pas | 54 -
src/menu/UMenuSelectSlide.pas | 439 -
src/menu/UMenuStatic.pas | 117 -
src/menu/UMenuText.pas | 379 -
src/screens/UScreenCredits.pas | 1466 ---
src/screens/UScreenEdit.pas | 164 -
src/screens/UScreenEditConvert.pas | 827 --
src/screens/UScreenEditHeader.pas | 445 -
src/screens/UScreenEditSub.pas | 1520 ----
src/screens/UScreenLevel.pas | 139 -
src/screens/UScreenLoading.pas | 78 -
src/screens/UScreenMain.pas | 266 -
src/screens/UScreenName.pas | 284 -
src/screens/UScreenOpen.pas | 231 -
src/screens/UScreenOptions.pas | 234 -
src/screens/UScreenOptionsAdvanced.pas | 171 -
src/screens/UScreenOptionsGame.pas | 175 -
src/screens/UScreenOptionsGraphics.pas | 172 -
src/screens/UScreenOptionsLyrics.pas | 148 -
src/screens/UScreenOptionsRecord.pas | 813 --
src/screens/UScreenOptionsSound.pas | 187 -
src/screens/UScreenOptionsThemes.pas | 206 -
src/screens/UScreenPartyNewRound.pas | 463 -
src/screens/UScreenPartyOptions.pas | 318 -
src/screens/UScreenPartyPlayer.pas | 385 -
src/screens/UScreenPartyScore.pas | 343 -
src/screens/UScreenPartyWin.pas | 302 -
src/screens/UScreenPopup.pas | 308 -
src/screens/UScreenScore.pas | 924 --
src/screens/UScreenSing.pas | 1001 --
src/screens/UScreenSingModi.pas | 582 --
src/screens/UScreenSong.pas | 2061 -----
src/screens/UScreenSongJumpto.pas | 244 -
src/screens/UScreenSongMenu.pas | 661 --
src/screens/UScreenStatDetail.pas | 303 -
src/screens/UScreenStatMain.pas | 323 -
src/screens/UScreenTop5.pas | 307 -
src/screens/UScreenWelcome.pas | 164 -
172 files changed, 131216 deletions(-)
delete mode 100644 src/base/TextGL.pas
delete mode 100644 src/base/UBeatTimer.pas
delete mode 100644 src/base/UCatCovers.pas
delete mode 100644 src/base/UCommandLine.pas
delete mode 100644 src/base/UCommon.pas
delete mode 100644 src/base/UConfig.pas
delete mode 100644 src/base/UCovers.pas
delete mode 100644 src/base/UDLLManager.pas
delete mode 100644 src/base/UDataBase.pas
delete mode 100644 src/base/UDraw.pas
delete mode 100644 src/base/UEditorLyrics.pas
delete mode 100644 src/base/UFiles.pas
delete mode 100644 src/base/UFilesystem.pas
delete mode 100644 src/base/UFont.pas
delete mode 100644 src/base/UGraphic.pas
delete mode 100644 src/base/UGraphicClasses.pas
delete mode 100644 src/base/UIni.pas
delete mode 100644 src/base/UJoystick.pas
delete mode 100644 src/base/ULog.pas
delete mode 100644 src/base/ULyrics.pas
delete mode 100644 src/base/UMain.pas
delete mode 100644 src/base/UMusic.pas
delete mode 100644 src/base/UNote.pas
delete mode 100644 src/base/UParty.pas
delete mode 100644 src/base/UPathUtils.pas
delete mode 100644 src/base/UPlatform.pas
delete mode 100644 src/base/UPlatformLinux.pas
delete mode 100644 src/base/UPlatformMacOSX.pas
delete mode 100644 src/base/UPlatformWindows.pas
delete mode 100644 src/base/UPlaylist.pas
delete mode 100644 src/base/URecord.pas
delete mode 100644 src/base/USingScores.pas
delete mode 100644 src/base/USkins.pas
delete mode 100644 src/base/USong.pas
delete mode 100644 src/base/USongs.pas
delete mode 100644 src/base/UTextEncoding.pas
delete mode 100644 src/base/UTexture.pas
delete mode 100644 src/base/UThemes.pas
delete mode 100644 src/base/UUnicodeUtils.pas
delete mode 100644 src/base/UXMLSong.pas
delete mode 100644 src/lib/FreeImage/FreeBitmap.pas
delete mode 100644 src/lib/FreeImage/FreeImage.pas
delete mode 100644 src/lib/JEDI-SDL/OpenGL/Pas/geometry.pas
delete mode 100644 src/lib/JEDI-SDL/OpenGL/Pas/gl.pas
delete mode 100644 src/lib/JEDI-SDL/OpenGL/Pas/glext.pas
delete mode 100644 src/lib/JEDI-SDL/OpenGL/Pas/glu.pas
delete mode 100644 src/lib/JEDI-SDL/OpenGL/Pas/glut.pas
delete mode 100644 src/lib/JEDI-SDL/OpenGL/Pas/glx.pas
delete mode 100644 src/lib/JEDI-SDL/SDL/Pas/libxmlparser.pas
delete mode 100644 src/lib/JEDI-SDL/SDL/Pas/logger.pas
delete mode 100644 src/lib/JEDI-SDL/SDL/Pas/moduleloader.pas
delete mode 100644 src/lib/JEDI-SDL/SDL/Pas/registryuserpreferences.pas
delete mode 100644 src/lib/JEDI-SDL/SDL/Pas/sdl.pas
delete mode 100644 src/lib/JEDI-SDL/SDL/Pas/sdl_cpuinfo.pas
delete mode 100644 src/lib/JEDI-SDL/SDL/Pas/sdlgameinterface.pas
delete mode 100644 src/lib/JEDI-SDL/SDL/Pas/sdli386utils.pas
delete mode 100644 src/lib/JEDI-SDL/SDL/Pas/sdlinput.pas
delete mode 100644 src/lib/JEDI-SDL/SDL/Pas/sdlstreams.pas
delete mode 100644 src/lib/JEDI-SDL/SDL/Pas/sdlticks.pas
delete mode 100644 src/lib/JEDI-SDL/SDL/Pas/sdlutils.pas
delete mode 100644 src/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas
delete mode 100644 src/lib/JEDI-SDL/SDL/Pas/userpreferences.pas
delete mode 100644 src/lib/JEDI-SDL/SDL_Image/Pas/sdl_image.pas
delete mode 100644 src/lib/SQLite/SQLite3.pas
delete mode 100644 src/lib/SQLite/SQLiteTable3.pas
delete mode 100644 src/lib/SQLite/example/uTestSqlite.pas
delete mode 100644 src/lib/TntUnicodeControls/TntClasses.pas
delete mode 100644 src/lib/TntUnicodeControls/TntFormatStrUtils.pas
delete mode 100644 src/lib/TntUnicodeControls/TntSysUtils.pas
delete mode 100644 src/lib/TntUnicodeControls/TntSystem.pas
delete mode 100644 src/lib/TntUnicodeControls/TntWideStrUtils.pas
delete mode 100644 src/lib/TntUnicodeControls/TntWideStrings.pas
delete mode 100644 src/lib/TntUnicodeControls/TntWindows.pas
delete mode 100644 src/lib/bass/delphi/bass.pas
delete mode 100644 src/lib/collections/CollArray.pas
delete mode 100644 src/lib/collections/CollHash.pas
delete mode 100644 src/lib/collections/CollLibrary.pas
delete mode 100644 src/lib/collections/CollList.pas
delete mode 100644 src/lib/collections/CollPArray.pas
delete mode 100644 src/lib/collections/CollWrappers.pas
delete mode 100644 src/lib/collections/Collections.pas
delete mode 100644 src/lib/ctypes/ctypes.pas
delete mode 100644 src/lib/ffmpeg/avcodec.pas
delete mode 100644 src/lib/ffmpeg/avformat.pas
delete mode 100644 src/lib/ffmpeg/avio.pas
delete mode 100644 src/lib/ffmpeg/avutil.pas
delete mode 100644 src/lib/ffmpeg/mathematics.pas
delete mode 100644 src/lib/ffmpeg/opt.pas
delete mode 100644 src/lib/ffmpeg/rational.pas
delete mode 100644 src/lib/ffmpeg/swscale.pas
delete mode 100644 src/lib/fft/UFFT.pas
delete mode 100644 src/lib/freetype/demo/nehe/UFreeType.pas
delete mode 100644 src/lib/freetype/freetype.pas
delete mode 100644 src/lib/libpng/png.pas
delete mode 100644 src/lib/midi/MidiFile.pas
delete mode 100644 src/lib/midi/MidiScope.pas
delete mode 100644 src/lib/midi/Midicons.pas
delete mode 100644 src/lib/midi/Midiin.pas
delete mode 100644 src/lib/midi/Midiout.pas
delete mode 100644 src/lib/midi/demo/MidiTest.pas
delete mode 100644 src/lib/other/DirWatch.pas
delete mode 100644 src/lib/other/WinAllocation.pas
delete mode 100644 src/lib/pcre/pcre.pas
delete mode 100644 src/lib/portaudio/portaudio.pas
delete mode 100644 src/lib/portmixer/portmixer.pas
delete mode 100644 src/lib/projectM/projectM.pas
delete mode 100644 src/lib/samplerate/samplerate.pas
delete mode 100644 src/lib/zlib/zlib.pas
delete mode 100644 src/macosx/PseudoThread.pas
delete mode 100644 src/media/UAudioConverter.pas
delete mode 100644 src/media/UAudioCore_Bass.pas
delete mode 100644 src/media/UAudioCore_Portaudio.pas
delete mode 100644 src/media/UAudioDecoder_Bass.pas
delete mode 100644 src/media/UAudioDecoder_FFmpeg.pas
delete mode 100644 src/media/UAudioInput_Bass.pas
delete mode 100644 src/media/UAudioInput_Portaudio.pas
delete mode 100644 src/media/UAudioPlaybackBase.pas
delete mode 100644 src/media/UAudioPlayback_Bass.pas
delete mode 100644 src/media/UAudioPlayback_Portaudio.pas
delete mode 100644 src/media/UAudioPlayback_SDL.pas
delete mode 100644 src/media/UAudioPlayback_SoftMixer.pas
delete mode 100644 src/media/UMediaCore_FFmpeg.pas
delete mode 100644 src/media/UMediaCore_SDL.pas
delete mode 100644 src/media/UMedia_dummy.pas
delete mode 100644 src/media/UVideo.pas
delete mode 100644 src/media/UVisualizer.pas
delete mode 100644 src/menu/UDrawTexture.pas
delete mode 100644 src/menu/UMenu.pas
delete mode 100644 src/menu/UMenuBackgroundFade.pas
delete mode 100644 src/menu/UMenuBackgroundTexture.pas
delete mode 100644 src/menu/UMenuBackgroundVideo.pas
delete mode 100644 src/menu/UMenuButton.pas
delete mode 100644 src/menu/UMenuButtonCollection.pas
delete mode 100644 src/menu/UMenuEqualizer.pas
delete mode 100644 src/menu/UMenuInteract.pas
delete mode 100644 src/menu/UMenuSelectSlide.pas
delete mode 100644 src/menu/UMenuStatic.pas
delete mode 100644 src/menu/UMenuText.pas
delete mode 100644 src/screens/UScreenCredits.pas
delete mode 100644 src/screens/UScreenEdit.pas
delete mode 100644 src/screens/UScreenEditConvert.pas
delete mode 100644 src/screens/UScreenEditHeader.pas
delete mode 100644 src/screens/UScreenEditSub.pas
delete mode 100644 src/screens/UScreenLevel.pas
delete mode 100644 src/screens/UScreenLoading.pas
delete mode 100644 src/screens/UScreenMain.pas
delete mode 100644 src/screens/UScreenName.pas
delete mode 100644 src/screens/UScreenOpen.pas
delete mode 100644 src/screens/UScreenOptions.pas
delete mode 100644 src/screens/UScreenOptionsAdvanced.pas
delete mode 100644 src/screens/UScreenOptionsGame.pas
delete mode 100644 src/screens/UScreenOptionsGraphics.pas
delete mode 100644 src/screens/UScreenOptionsLyrics.pas
delete mode 100644 src/screens/UScreenOptionsRecord.pas
delete mode 100644 src/screens/UScreenOptionsSound.pas
delete mode 100644 src/screens/UScreenOptionsThemes.pas
delete mode 100644 src/screens/UScreenPartyNewRound.pas
delete mode 100644 src/screens/UScreenPartyOptions.pas
delete mode 100644 src/screens/UScreenPartyPlayer.pas
delete mode 100644 src/screens/UScreenPartyScore.pas
delete mode 100644 src/screens/UScreenPartyWin.pas
delete mode 100644 src/screens/UScreenPopup.pas
delete mode 100644 src/screens/UScreenScore.pas
delete mode 100644 src/screens/UScreenSing.pas
delete mode 100644 src/screens/UScreenSingModi.pas
delete mode 100644 src/screens/UScreenSong.pas
delete mode 100644 src/screens/UScreenSongJumpto.pas
delete mode 100644 src/screens/UScreenSongMenu.pas
delete mode 100644 src/screens/UScreenStatDetail.pas
delete mode 100644 src/screens/UScreenStatMain.pas
delete mode 100644 src/screens/UScreenTop5.pas
delete mode 100644 src/screens/UScreenWelcome.pas
(limited to 'src')
diff --git a/src/base/TextGL.pas b/src/base/TextGL.pas
deleted file mode 100644
index 7fe98d29..00000000
--- a/src/base/TextGL.pas
+++ /dev/null
@@ -1,211 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit TextGL;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- gl,
- glext,
- SDL,
- Classes,
- UTexture,
- UFont,
- UPath,
- ULog;
-
-type
- PGLFont = ^TGLFont;
- TGLFont = record
- Font: TScalableFont;
- X, Y, Z: real;
- end;
-
-var
- Fonts: array of TGLFont;
- ActFont: integer;
-
-procedure BuildFont; // build our bitmap font
-procedure KillFont; // delete the font
-function glTextWidth(const text: UTF8String): real; // returns text width
-procedure glPrint(const text: UTF8String); // custom GL "Print" routine
-procedure ResetFont(); // reset font settings of active font
-procedure SetFontPos(X, Y: real); // sets X and Y
-procedure SetFontZ(Z: real); // sets Z
-procedure SetFontSize(Size: real);
-procedure SetFontStyle(Style: integer); // sets active font style (normal, bold, etc)
-procedure SetFontItalic(Enable: boolean); // sets italic type letter (works for all fonts)
-procedure SetFontReflection(Enable:boolean;Spacing: real); // enables/disables text reflection
-
-implementation
-
-uses
- UTextEncoding,
- SysUtils,
- IniFiles,
- UCommon,
- UMain,
- UPathUtils;
-
-function FindFontFile(FontIni: TCustomIniFile; Font: string): IPath;
-var
- Filename: IPath;
-begin
- Filename := Path(FontIni.ReadString(Font, 'File', ''));
- Result := FontPath.Append(Filename);
- // if path does not exist, try as an absolute path
- if (not Result.IsFile) then
- Result := Filename;
-end;
-
-procedure BuildFont;
-var
- FontIni: TMemIniFile;
- FontFile: IPath;
-begin
- ActFont := 0;
-
- SetLength(Fonts, 4);
- FontIni := TMemIniFile.Create(FontPath.Append('fonts.ini').ToNative);
-
- try
-
- // Normal
- FontFile := FindFontFile(FontIni, 'Normal');
- Fonts[0].Font := TFTScalableFont.Create(FontFile, 64);
- //Fonts[0].Font.GlyphSpacing := 1.4;
- //Fonts[0].Font.Aspect := 1.2;
-
- // Bold
- FontFile := FindFontFile(FontIni, 'Bold');
- Fonts[1].Font := TFTScalableFont.Create(FontFile, 64);
-
- // Outline1
- FontFile := FindFontFile(FontIni, 'Outline1');
- Fonts[2].Font := TFTScalableOutlineFont.Create(FontFile, 64, 0.06);
- //TFTScalableOutlineFont(Fonts[2].Font).SetOutlineColor(0.3, 0.3, 0.3);
-
- // Outline2
- FontFile := FindFontFile(FontIni, 'Outline2');
- Fonts[3].Font := TFTScalableOutlineFont.Create(FontFile, 64, 0.08);
-
- except
- on E: Exception do
- Log.LogCritical(E.Message, 'BuildFont');
- end;
-
- // close ini-file
- FontIni.Free;
-end;
-
-
-// Deletes the font
-procedure KillFont;
-begin
- // delete all characters
- //glDeleteLists(..., 256);
-end;
-
-function glTextWidth(const text: UTF8String): real;
-var
- Bounds: TBoundsDbl;
-begin
- Bounds := Fonts[ActFont].Font.BBox(Text, true);
- Result := Bounds.Right - Bounds.Left;
-end;
-
-// Custom GL "Print" Routine
-procedure glPrint(const Text: UTF8String);
-var
- GLFont: PGLFont;
-begin
- // if there is no text do nothing
- if (Text = '') then
- Exit;
-
- GLFont := @Fonts[ActFont];
-
- glPushMatrix();
- // set font position
- glTranslatef(GLFont.X, GLFont.Y + GLFont.Font.Ascender, GLFont.Z);
- // draw string
- GLFont.Font.Print(Text);
- glPopMatrix();
-end;
-
-procedure ResetFont();
-begin
- SetFontPos(0, 0);
- SetFontZ(0);
- SetFontItalic(False);
- SetFontReflection(False, 0);
-end;
-
-procedure SetFontPos(X, Y: real);
-begin
- Fonts[ActFont].X := X;
- Fonts[ActFont].Y := Y;
-end;
-
-procedure SetFontZ(Z: real);
-begin
- Fonts[ActFont].Z := Z;
-end;
-
-procedure SetFontSize(Size: real);
-begin
- Fonts[ActFont].Font.Height := Size;
-end;
-
-procedure SetFontStyle(Style: integer);
-begin
- ActFont := Style;
-end;
-
-procedure SetFontItalic(Enable: boolean);
-begin
- if (Enable) then
- Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style + [Italic]
- else
- Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style - [Italic]
-end;
-
-procedure SetFontReflection(Enable: boolean; Spacing: real);
-begin
- if (Enable) then
- Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style + [Reflect]
- else
- Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style - [Reflect];
- Fonts[ActFont].Font.ReflectionSpacing := Spacing - Fonts[ActFont].Font.Descender;
-end;
-
-end.
diff --git a/src/base/UBeatTimer.pas b/src/base/UBeatTimer.pas
deleted file mode 100644
index 310a49cd..00000000
--- a/src/base/UBeatTimer.pas
+++ /dev/null
@@ -1,170 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UBeatTimer;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- UTime;
-
-type
- (**
- * TLyricsState contains all information concerning the
- * state of the lyrics, e.g. the current beat or duration of the lyrics.
- *)
- TLyricsState = class
- private
- Timer: TRelativeTimer; // keeps track of the current time
- public
- OldBeat: integer; // previous discovered beat
- CurrentBeat: integer; // current beat (rounded)
- MidBeat: real; // current beat (float)
-
- // now we use this for super synchronization!
- // only used when analyzing voice
- // TODO: change ...D to ...Detect(ed)
- OldBeatD: integer; // previous discovered beat
- CurrentBeatD: integer; // current discovered beat (rounded)
- MidBeatD: real; // current discovered beat (float)
-
- // we use this for audible clicks
- // TODO: Change ...C to ...Click
- OldBeatC: integer; // previous discovered beat
- CurrentBeatC: integer;
- MidBeatC: real; // like CurrentBeatC
-
- OldLine: integer; // previous displayed sentence
-
- StartTime: real; // time till start of lyrics (= Gap)
- TotalTime: real; // total song time
-
- constructor Create();
- procedure Pause();
- procedure Resume();
-
- procedure Reset();
- procedure UpdateBeats();
-
- (**
- * current song time (in seconds) used as base-timer for lyrics etc.
- *)
- function GetCurrentTime(): real;
- procedure SetCurrentTime(Time: real);
- end;
-
-implementation
-uses UNote, Math;
-
-
-constructor TLyricsState.Create();
-begin
- // create a triggered timer, so we can Pause() it, set the time
- // and Resume() it afterwards for better synching.
- Timer := TRelativeTimer.Create(true);
-
- // reset state
- Reset();
-end;
-
-procedure TLyricsState.Pause();
-begin
- Timer.Pause();
-end;
-
-procedure TLyricsState.Resume();
-begin
- Timer.Resume();
-end;
-
-procedure TLyricsState.SetCurrentTime(Time: real);
-begin
- // do not start the timer (if not started already),
- // after setting the current time
- Timer.SetTime(Time, false);
-end;
-
-function TLyricsState.GetCurrentTime(): real;
-begin
- Result := Timer.GetTime();
-end;
-
-(**
- * Resets the timer and state of the lyrics.
- * The timer will be stopped afterwards so you have to call Resume()
- * to start the lyrics timer.
- *)
-procedure TLyricsState.Reset();
-begin
- Pause();
- SetCurrentTime(0);
-
- StartTime := 0;
- TotalTime := 0;
-
- OldBeat := -1;
- MidBeat := -1;
- CurrentBeat := -1;
-
- OldBeatC := -1;
- MidBeatC := -1;
- CurrentBeatC := -1;
-
- OldBeatD := -1;
- MidBeatD := -1;
- CurrentBeatD := -1;
-end;
-
-(**
- * Updates the beat information (CurrentBeat/MidBeat/...) according to the
- * current lyric time.
- *)
-procedure TLyricsState.UpdateBeats();
-var
- CurLyricsTime: real;
-begin
- CurLyricsTime := GetCurrentTime();
-
- OldBeat := CurrentBeat;
- MidBeat := GetMidBeat(CurLyricsTime - StartTime / 1000);
- CurrentBeat := Floor(MidBeat);
-
- OldBeatC := CurrentBeatC;
- MidBeatC := GetMidBeat(CurLyricsTime - StartTime / 1000);
- CurrentBeatC := Floor(MidBeatC);
-
- OldBeatD := CurrentBeatD;
- // MidBeatD = MidBeat with additional GAP
- MidBeatD := -0.5 + GetMidBeat(CurLyricsTime - (StartTime + 120 + 20) / 1000);
- CurrentBeatD := Floor(MidBeatD);
-end;
-
-end.
\ No newline at end of file
diff --git a/src/base/UCatCovers.pas b/src/base/UCatCovers.pas
deleted file mode 100644
index d33bbbe1..00000000
--- a/src/base/UCatCovers.pas
+++ /dev/null
@@ -1,214 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UCatCovers;
-/////////////////////////////////////////////////////////////////////////
-// UCatCovers by Whiteshark //
-// Class for listing and managing the Category Covers //
-/////////////////////////////////////////////////////////////////////////
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- UIni,
- UPath;
-
-type
- TCatCovers = class
- protected
- cNames: array [0..high(ISorting)] of array of UTF8String;
- cFiles: array [0..high(ISorting)] of array of IPath;
- public
- constructor Create;
- procedure Load; //Load Cover aus Cover.ini and Cover Folder
- procedure LoadPath(const CoversPath: IPath);
- procedure Add(Sorting: integer; const Name: UTF8String; const Filename: IPath); //Add a Cover
- function CoverExists(Sorting: integer; const Name: UTF8String): boolean; //Returns True when a cover with the given Name exists
- function GetCover(Sorting: integer; const Name: UTF8String): IPath; //Returns the Filename of a Cover
- end;
-
-var
- CatCovers: TCatCovers;
-
-implementation
-
-uses
- IniFiles,
- SysUtils,
- Classes,
- UFilesystem,
- ULog,
- UMain,
- UUnicodeUtils,
- UPathUtils;
-
-constructor TCatCovers.Create;
-begin
- inherited;
- Load;
-end;
-
-procedure TCatCovers.Load;
-var
- I: integer;
-begin
- for I := 0 to CoverPaths.Count-1 do
- LoadPath(CoverPaths[I] as IPath);
-end;
-
-(**
- * Load Cover from Cover.ini and Cover Folder
- *)
-procedure TCatCovers.LoadPath(const CoversPath: IPath);
-var
- Ini: TMemIniFile;
- List: TStringlist;
- I, J: Integer;
- Filename: IPath;
- Name, TmpName: UTF8String;
- CatCover: IPath;
- Iter: IFileIterator;
- FileInfo: TFileInfo;
-begin
- Ini := nil;
- List := nil;
-
- try
- Ini := TMemIniFile.Create(CoversPath.Append('covers.ini').ToNative);
- List := TStringlist.Create;
-
- //Add every Cover in Covers Ini for Every Sorting option
- for I := 0 to High(ISorting) do
- begin
- Ini.ReadSection(ISorting[I], List);
-
- for J := 0 to List.Count - 1 do
- begin
- CatCover := Path(Ini.ReadString(ISorting[I], List.Strings[J], 'NoCover.jpg'));
- Add(I, List.Strings[J], CoversPath.Append(CatCover));
- end;
- end;
- finally
- Ini.Free;
- List.Free;
- end;
-
- //Add Covers from Folder
- Iter := FileSystem.FileFind(CoversPath.Append('*.jpg'), 0);
- while Iter.HasNext do
- begin
- FileInfo := Iter.Next;
-
- //Add Cover if it doesn't exist for every Section
- Filename := CoversPath.Append(FileInfo.Name);
- Name := FileInfo.Name.SetExtension('').ToUTF8;
-
- for I := 0 to high(ISorting) do
- begin
- TmpName := Name;
- if (I = sTitle) and (UTF8Pos('Title', TmpName) <> 0) then
- UTF8Delete(TmpName, UTF8Pos('Title', TmpName), 5)
- else if (I = sArtist) and (UTF8Pos('Artist', TmpName) <> 0) then
- UTF8Delete(TmpName, UTF8Pos('Artist', TmpName), 6);
-
- if not CoverExists(I, TmpName) then
- Add(I, TmpName, Filename);
- end;
- end;
-end;
-
- //Add a Cover
-procedure TCatCovers.Add(Sorting: integer; const Name: UTF8String; const Filename: IPath);
-begin
- if Filename.IsFile then //If Exists -> Add
- begin
- SetLength(CNames[Sorting], Length(CNames[Sorting]) + 1);
- SetLength(CFiles[Sorting], Length(CNames[Sorting]) + 1);
-
- CNames[Sorting][high(cNames[Sorting])] := UTF8Uppercase(Name);
- CFiles[Sorting][high(cNames[Sorting])] := FileName;
- end;
-end;
-
- //Returns True when a cover with the given Name exists
-function TCatCovers.CoverExists(Sorting: integer; const Name: UTF8String): boolean;
-var
- I: Integer;
- UpperName: UTF8String;
-begin
- Result := False;
- UpperName := UTF8Uppercase(Name); //Case Insensitiv
-
- for I := 0 to high(cNames[Sorting]) do
- begin
- if (cNames[Sorting][I] = UpperName) then //Found Name
- begin
- Result := true;
- break; //Break For Loop
- end;
- end;
-end;
-
- //Returns the Filename of a Cover
-function TCatCovers.GetCover(Sorting: integer; const Name: UTF8String): IPath;
-var
- I: Integer;
- UpperName: UTF8String;
- NoCoverPath: IPath;
-begin
- Result := PATH_NONE;
- UpperName := UTF8Uppercase(Name);
-
- for I := 0 to high(cNames[Sorting]) do
- begin
- if cNames[Sorting][I] = UpperName then
- begin
- Result := cFiles[Sorting][I];
- Break;
- end;
- end;
-
- //No Cover
- if (Result.IsUnset) then
- begin
- for I := 0 to CoverPaths.Count-1 do
- begin
- NoCoverPath := (CoverPaths[I] as IPath).Append('NoCover.jpg');
- if (NoCoverPath.IsFile) then
- begin
- Result := NoCoverPath;
- Break;
- end;
- end;
- end;
-end;
-
-end.
diff --git a/src/base/UCommandLine.pas b/src/base/UCommandLine.pas
deleted file mode 100644
index ac0db2c2..00000000
--- a/src/base/UCommandLine.pas
+++ /dev/null
@@ -1,345 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UCommandLine;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- UPath;
-
-type
- TScreenMode = (scmDefault, scmFullscreen, scmWindowed);
-
- {**
- * Reads infos from ParamStr and set some easy interface variables
- *}
- TCMDParams = class
- private
- fLanguage: string;
- fResolution: string;
-
- procedure ShowHelp();
-
- procedure ReadParamInfo;
- procedure ResetVariables;
-
- function GetLanguage: integer;
- function GetResolution: integer;
- public
- // some boolean variables set when reading infos
- Debug: boolean;
- Benchmark: boolean;
- NoLog: boolean;
- ScreenMode: TScreenMode;
- Joypad: boolean;
-
- // some value variables set when reading infos {-1: Not Set, others: Value}
- Depth: integer;
- Screens: integer;
-
- // some strings set when reading infos {Length=0: Not Set}
- SongPath: IPath;
- ConfigFile: IPath;
- ScoreFile: IPath;
-
- // pseudo integer values
- property Language: integer read GetLanguage;
- property Resolution: integer read GetResolution;
-
- // some procedures for reading infos
- constructor Create;
- end;
-
-var
- Params: TCMDParams;
-
-const
- cHelp = 'help';
- cDebug = 'debug';
- cMediaInterfaces = 'showinterfaces';
-
-
-implementation
-
-uses SysUtils,
- UPlatform;
-
-{**
- * Resets variables and reads info
- *}
-constructor TCMDParams.Create;
-begin
- inherited;
-
- if FindCmdLineSwitch( cHelp ) or FindCmdLineSwitch( 'h' ) then
- ShowHelp();
-
- ResetVariables;
- ReadParamInfo;
-end;
-
-procedure TCMDParams.ShowHelp();
-
- function Fmt(aString : string) : string;
- begin
- Result := Format('%-15s', [aString]);
- end;
-
-begin
- writeln;
- writeln('**************************************************************');
- writeln(' UltraStar Deluxe - Command line switches ');
- writeln('**************************************************************');
- writeln;
- writeln(' '+ Fmt('Switch') +' : Purpose');
- writeln(' ----------------------------------------------------------');
- writeln(' '+ Fmt(cMediaInterfaces) +' : Show in-use media interfaces');
- writeln(' '+ Fmt(cDebug) +' : Display Debugging info');
- writeln;
-
- platform.halt;
-end;
-
-{**
- * Reset Class Variables
- *}
-procedure TCMDParams.ResetVariables;
-begin
- Debug := False;
- Benchmark := False;
- NoLog := False;
- ScreenMode := scmDefault;
- Joypad := False;
-
- // some value variables set when reading infos {-1: Not Set, others: Value}
- fResolution := '';
- fLanguage := '';
- Depth := -1;
- Screens := -1;
-
- // some strings set when reading infos {Length=0 Not Set}
- SongPath := PATH_NONE;
- ConfigFile := PATH_NONE;
- ScoreFile := PATH_NONE;
-end;
-
-{**
- * Read command-line parameters
- *}
-procedure TCMDParams.ReadParamInfo;
-var
- I: integer;
- PCount: integer;
- Command: string;
-begin
- PCount := ParamCount;
- //Log.LogError('ParamCount: ' + Inttostr(PCount));
-
- // check all parameters
- for I := 1 to PCount do
- begin
- Command := ParamStr(I);
- // check if the string is a parameter
- if (Length(Command) > 1) and (Command[1] = '-') then
- begin
- // remove '-' from command
- Command := LowerCase(Trim(Copy(Command, 2, Length(Command) - 1)));
- //Log.LogError('Command prepared: ' + Command);
-
- // check command
-
- // boolean triggers
- if (Command = 'debug') then
- Debug := True
- else if (Command = 'benchmark') then
- Benchmark := True
- else if (Command = 'nolog') then
- NoLog := True
- else if (Command = 'fullscreen') then
- ScreenMode := scmFullscreen
- else if (Command = 'window') then
- ScreenMode := scmWindowed
- else if (Command = 'joypad') then
- Joypad := True
-
- // integer variables
- else if (Command = 'depth') then
- begin
- // check if there is another Parameter to get the Value from
- if (PCount > I) then
- begin
- Command := ParamStr(I + 1);
-
- // check for valid value
- // FIXME: guessing an array-index of depth is very error prone.
- If (Command = '16') then
- Depth := 0
- Else If (Command = '32') then
- Depth := 1;
- end;
- end
-
- else if (Command = 'screens') then
- begin
- // check if there is another parameter to get the value from
- if (PCount > I) then
- begin
- Command := ParamStr(I + 1);
-
- // check for valid value
- If (Command = '1') then
- Screens := 0
- Else If (Command = '2') then
- Screens := 1;
- end;
- end
-
- // pseudo integer values
- else if (Command = 'language') then
- begin
- // check if there is another parameter to get the value from
- if (PCount > I) then
- begin
- // write value to string
- fLanguage := Lowercase(ParamStr(I + 1));
- end;
- end
-
- else if (Command = 'resolution') then
- begin
- // check if there is another parameter to get the value from
- if (PCount > I) then
- begin
- // write value to string
- fResolution := Lowercase(ParamStr(I + 1));
- end;
- end
-
- // string values
- else if (Command = 'songpath') then
- begin
- // check if there is another parameter to get the value from
- if (PCount > I) then
- begin
- // write value to string
- SongPath := Path(ParamStr(I + 1));
- end;
- end
-
- else if (Command = 'configfile') then
- begin
- // check if there is another parameter to get the value from
- if (PCount > I) then
- begin
- // write value to string
- ConfigFile := Path(ParamStr(I + 1));
-
- // is this a relative path -> then add gamepath
- if (not ConfigFile.IsAbsolute) then
- ConfigFile := Platform.GetExecutionDir().Append(ConfigFile);
- end;
- end
-
- else if (Command = 'scorefile') then
- begin
- // check if there is another parameter to get the value from
- if (PCount > I) then
- begin
- // write value to string
- ScoreFile := Path(ParamStr(I + 1));
- end;
- end;
-
- end;
-
- end;
-
-{
- Log.LogInfo('Screens: ' + Inttostr(Screens));
- Log.LogInfo('Depth: ' + Inttostr(Depth));
-
- Log.LogInfo('Resolution: ' + Inttostr(Resolution));
- Log.LogInfo('Resolution: ' + Inttostr(Language));
-
- Log.LogInfo('sResolution: ' + sResolution);
- Log.LogInfo('sLanguage: ' + sLanguage);
-
- Log.LogInfo('ConfigFile: ' + ConfigFile);
- Log.LogInfo('SongPath: ' + SongPath);
- Log.LogInfo('ScoreFile: ' + ScoreFile);
-}
-
-end;
-
-//-------------
-// GetLanguage - Get Language ID from saved String Information
-//-------------
-function TCMDParams.GetLanguage: integer;
-{var
- I: integer;
-}
-begin
- Result := -1;
-{* JB - 12sep07 to remove uINI dependency
-
- //Search for Language
- For I := 0 to high(ILanguage) do
- if (LowerCase(ILanguage[I]) = sLanguage) then
- begin
- Result := I;
- Break;
- end;
-*}
-end;
-
-//-------------
-// GetResolution - Get Resolution ID from saved String Information
-//-------------
-function TCMDParams.GetResolution: integer;
-{var
- I: integer;
-}
-begin
- Result := -1;
-{* JB - 12sep07 to remove uINI dependency
-
- //Search for Resolution
- For I := 0 to high(IResolution) do
- if (LowerCase(IResolution[I]) = sResolution) then
- begin
- Result := I;
- Break;
- end;
-*}
-end;
-
-end.
diff --git a/src/base/UCommon.pas b/src/base/UCommon.pas
deleted file mode 100644
index fa0faf3c..00000000
--- a/src/base/UCommon.pas
+++ /dev/null
@@ -1,584 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UCommon;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- SysUtils,
- Classes,
- {$IFDEF MSWINDOWS}
- Windows,
- {$ENDIF}
- UConfig,
- ULog,
- UPath;
-
-type
- TStringDynArray = array of string;
-
-const
- SepWhitespace = [#9, #10, #13, ' ']; // tab, lf, cr, space
-
-{**
- * Splits a string into pieces separated by Separators.
- * MaxCount specifies the max. number of pieces. If it is <= 0 the number is
- * not limited. If > 0 the last array element will hold the rest of the string
- * (with leading separators removed).
- *
- * Examples:
- * SplitString(' split me now ', 0) -> ['split', 'me', 'now']
- * SplitString(' split me now ', 1) -> ['split', 'me now']
- *}
-function SplitString(const Str: string; MaxCount: integer = 0; Separators: TSysCharSet = SepWhitespace): TStringDynArray;
-
-
-type
- TMessageType = (mtInfo, mtError);
-
-procedure ShowMessage(const msg: string; msgType: TMessageType = mtInfo);
-
-procedure ConsoleWriteLn(const msg: string);
-
-{$IFDEF FPC}
-function RandomRange(aMin: integer; aMax: integer): integer;
-{$ENDIF}
-
-procedure DisableFloatingPointExceptions();
-procedure SetDefaultNumericLocale();
-procedure RestoreNumericLocale();
-
-{$IFNDEF MSWINDOWS}
-procedure ZeroMemory(Destination: pointer; Length: dword);
-function MakeLong(a, b: word): longint;
-{$ENDIF}
-
-// A stable alternative to TList.Sort() (use TList.Sort() if applicable, see below)
-procedure MergeSort(List: TList; CompareFunc: TListSortCompare);
-
-function GetAlignedMem(Size: cardinal; Alignment: integer): pointer;
-procedure FreeAlignedMem(P: pointer);
-
-
-implementation
-
-uses
- Math,
- {$IFDEF Delphi}
- Dialogs,
- {$ENDIF}
- sdl,
- UFilesystem,
- UMain,
- UUnicodeUtils;
-
-function SplitString(const Str: string; MaxCount: integer; Separators: TSysCharSet): TStringDynArray;
-
- {*
- * Adds Str[StartPos..Endpos-1] to the result array.
- *}
- procedure AddSplit(StartPos, EndPos: integer);
- begin
- SetLength(Result, Length(Result)+1);
- Result[High(Result)] := Copy(Str, StartPos, EndPos-StartPos);
- end;
-
-var
- I: integer;
- Start: integer;
- Last: integer;
-begin
- Start := 0;
- SetLength(Result, 0);
-
- for I := 1 to Length(Str) do
- begin
- if (Str[I] in Separators) then
- begin
- // end of component found
- if (Start > 0) then
- begin
- AddSplit(Start, I);
- Start := 0;
- end;
- end
- else if (Start = 0) then
- begin
- // mark beginning of component
- Start := I;
- // check if this is the last component
- if (Length(Result) = MaxCount-1) then
- begin
- // find last non-separator char
- Last := Length(Str);
- while (Str[Last] in Separators) do
- Dec(Last);
- // add component up to last non-separator
- AddSplit(Start, Last);
- Exit;
- end;
- end;
- end;
-
- // last component
- if (Start > 0) then
- AddSplit(Start, Length(Str)+1);
-end;
-
-// data used by the ...Locale() functions
-{$IF Defined(Linux) or Defined(FreeBSD)}
-
-var
- PrevNumLocale: string;
-
-const
- LC_NUMERIC = 1;
-
-function setlocale(category: integer; locale: pchar): pchar; cdecl; external 'c' name 'setlocale';
-
-{$IFEND}
-
-// In Linux and maybe MacOSX some units (like cwstring) call setlocale(LC_ALL, '')
-// to set the language/country specific locale (e.g. charset) for this application.
-// Unfortunately, LC_NUMERIC is set by this call too.
-// It defines the decimal-separator and other country-specific numeric settings.
-// This parameter is used by the C string-to-float parsing functions atof() and strtod().
-// After changing LC_NUMERIC some external C-based libs (like projectM) are not
-// able to parse strings correctly
-// (e.g. in Germany "0.9" is not recognized as a valid number anymore but "0,9" is).
-// So we reset the numeric settings to the default ('C').
-// Note: The behaviour of Pascal parsing functions (e.g. strtofloat()) is not
-// changed by this because it doesn't use the locale-settings.
-// TODO:
-// - Check if this is needed in MacOSX (at least the locale is set in cwstring)
-// - Find out which libs are concerned by this problem.
-// If only projectM is concerned by this problem set and restore the numeric locale
-// for each call to projectM instead of changing it globally.
-procedure SetDefaultNumericLocale();
-begin
- {$IF Defined(LINUX) or Defined(FreeBSD)}
- PrevNumLocale := setlocale(LC_NUMERIC, nil);
- setlocale(LC_NUMERIC, 'C');
- {$IFEND}
-end;
-
-procedure RestoreNumericLocale();
-begin
- {$IF Defined(LINUX) or Defined(FreeBSD)}
- setlocale(LC_NUMERIC, PChar(PrevNumLocale));
- {$IFEND}
-end;
-
-(*
- * If an invalid floating point operation was performed the Floating-point unit (FPU)
- * generates a Floating-point exception (FPE). Dependending on the settings in
- * the FPU's control-register (interrupt mask) the FPE is handled by the FPU itself
- * (we will call this as "FPE disabled" later on) or is passed to the application
- * (FPE enabled).
- * If FPEs are enabled a floating-point division by zero (e.g. 10.0 / 0.0) is
- * considered an error and an exception is thrown. Otherwise the FPU will handle
- * the error and return the result infinity (INF) (10.0 / 0.0 = INF) without
- * throwing an error to the application.
- * The same applies to a division by INF that either raises an exception
- * (FPE enabled) or returns 0.0 (FPE disabled).
- * Normally (as with C-programs), Floating-point exceptions (FPE) are DISABLED
- * on program startup (at least with Intel CPUs), but for some strange reasons
- * they are ENABLED in pascal (both delphi and FPC) by default.
- * Many libs operating with floating-point values rely heavily on the C-specific
- * behaviour. So using them in delphi is a ticking time-bomb because sooner or
- * later they will crash because of an FPE (this problem occurs massively
- * in OpenGL-based libs like projectM). In contrast to this no error will occur
- * if the lib is linked to a C-program.
- *
- * Further info on FPUs:
- * For x86 and x86_64 CPUs we have to consider two FPU instruction sets.
- * The math co-processor i387 (aka 8087 or x87) set introduced with the i386
- * and SSE (Streaming SIMD Extensions) introduced with the Pentium3.
- * Both of them have separate control-registers (x87: FPUControlWord, SSE: MXCSR)
- * to control FPEs. Either has (among others) 6bits to enable/disable several
- * exception types (Invalid,Denormalized,Zero,Overflow,Underflow,Precision).
- * Those exception-types must all be masked (=1) to get the default C behaviour.
- * The control-registers can be set with the asm-ops FLDCW (x87) and LDMXCSR (SSE).
- * Instead of using assembler code, we can use Set8087CW() provided by delphi and
- * FPC to set the x87 control-word. FPC also provides SetSSECSR() for SSE's MXCSR.
- * Note that both Delphi and FPC enable FPEs (e.g. for div-by-zero) on program
- * startup but only FPC enables FPEs (especially div-by-zero) for SSE too.
- * So we have to mask FPEs for x87 in Delphi and FPC and for SSE in FPC only.
- * FPC and Delphi both provide a SetExceptionMask() for control of the FPE
- * mask. SetExceptionMask() sets the masks for x87 in Delphi and for x87 and SSE
- * in FPC (seems as if Delphi [2005] is not SSE aware). So SetExceptionMask()
- * is what we need and it even is plattform and CPU independent.
- *
- * Pascal OpenGL headers (like the Delphi standard ones or JEDI-SDL headers)
- * already call Set8087CW() to disable FPEs but due to some bugs in the JEDI-SDL
- * headers they do not work properly with FPC. I already patched them, so they
- * work at least until they are updated the next time. In addition Set8086CW()
- * does not suffice to disable FPEs because the SSE FPEs are not disabled by this.
- * FPEs with SSE are a big problem with some libs because many linux distributions
- * optimize code for SSE or Pentium3 (for example: int(INF) which convert the
- * double value "infinity" to an integer might be automatically optimized by
- * using SSE's CVTSD2SI instruction). So SSE FPEs must be turned off in any case
- * to make USDX portable.
- *
- * Summary:
- * Call this function on initialization to make sure FPEs are turned off.
- * It will solve a lot of errors with FPEs in external libs.
- *)
-procedure DisableFloatingPointExceptions();
-begin
- (*
- // We will use SetExceptionMask() instead of Set8087CW()/SetSSECSR().
- // Note: Leave these lines for documentation purposes just in case
- // SetExceptionMask() does not work anymore (due to bugs in FPC etc.).
- {$IF Defined(CPU386) or Defined(CPUI386) or Defined(CPUX86_64)}
- Set8087CW($133F);
- {$IFEND}
- {$IF Defined(FPC)}
- if (has_sse_support) then
- SetSSECSR($1F80);
- {$IFEND}
- *)
-
- // disable all of the six FPEs (x87 and SSE) to be compatible with C/C++ and
- // other libs which rely on the standard FPU behaviour (no div-by-zero FPE anymore).
- SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide,
- exOverflow, exUnderflow, exPrecision]);
-end;
-
-{$IFNDEF MSWINDOWS}
-procedure ZeroMemory(Destination: pointer; Length: dword);
-begin
- FillChar(Destination^, Length, 0);
-end;
-
-function MakeLong(A, B: word): longint;
-begin
- Result := (LongInt(B) shl 16) + A;
-end;
-
-{$ENDIF}
-
-{$IFDEF FPC}
-function RandomRange(aMin: integer; aMax: integer): integer;
-begin
- RandomRange := Random(aMax - aMin) + aMin ;
-end;
-{$ENDIF}
-
-
-{$IFDEF FPC}
-var
- MessageList: TStringList;
- ConsoleHandler: TThreadID;
- // Note: TRTLCriticalSection is defined in the units System and Libc, use System one
- ConsoleCriticalSection: System.TRTLCriticalSection;
- ConsoleEvent: PRTLEvent;
- ConsoleQuit: boolean;
-{$ENDIF}
-
-(*
- * Write to console if one is available.
- * It checks if a console is available before output so it will not
- * crash on windows if none is available.
- * Do not use this function directly because it is not thread-safe,
- * use ConsoleWriteLn() instead.
- *)
-procedure _ConsoleWriteLn(const aString: string); {$IFDEF HasInline}inline;{$ENDIF}
-begin
- {$IFDEF MSWINDOWS}
- // sanity check to avoid crashes with writeln()
- if (IsConsole) then
- begin
- {$ENDIF}
- Writeln(aString);
- {$IFDEF MSWINDOWS}
- end;
- {$ENDIF}
-end;
-
-{$IFDEF FPC}
-{*
- * The console-handlers main-function.
- * TODO: create a quit-event on closing.
- *}
-function ConsoleHandlerFunc(param: pointer): PtrInt;
-var
- i: integer;
- quit: boolean;
-begin
- quit := false;
- while (not quit) do
- begin
- // wait for new output or quit-request
- RTLeventWaitFor(ConsoleEvent);
-
- System.EnterCriticalSection(ConsoleCriticalSection);
- // output pending messages
- for i := 0 to MessageList.Count - 1 do
- begin
- _ConsoleWriteLn(MessageList[i]);
- end;
- MessageList.Clear();
-
- // use local quit-variable to avoid accessing
- // ConsoleQuit outside of the critical section
- if (ConsoleQuit) then
- quit := true;
-
- RTLeventResetEvent(ConsoleEvent);
- System.LeaveCriticalSection(ConsoleCriticalSection);
- end;
- result := 0;
-end;
-{$ENDIF}
-
-procedure InitConsoleOutput();
-begin
- {$IFDEF FPC}
- // init thread-safe output
- MessageList := TStringList.Create();
- System.InitCriticalSection(ConsoleCriticalSection);
- ConsoleEvent := RTLEventCreate();
- ConsoleQuit := false;
- // must be a thread managed by FPC. Otherwise (e.g. SDL-thread)
- // it will crash when using Writeln.
- ConsoleHandler := BeginThread(@ConsoleHandlerFunc);
- {$ENDIF}
-end;
-
-procedure FinalizeConsoleOutput();
-begin
- {$IFDEF FPC}
- // terminate console-handler
- System.EnterCriticalSection(ConsoleCriticalSection);
- ConsoleQuit := true;
- RTLeventSetEvent(ConsoleEvent);
- System.LeaveCriticalSection(ConsoleCriticalSection);
- WaitForThreadTerminate(ConsoleHandler, 0);
- // free data
- System.DoneCriticalsection(ConsoleCriticalSection);
- RTLeventDestroy(ConsoleEvent);
- MessageList.Free();
- {$ENDIF}
-end;
-
-{*
- * FPC uses threadvars (TLS) managed by FPC for console output locking.
- * Using WriteLn() from external threads (like in SDL callbacks)
- * will crash the program as those threadvars have never been initialized.
- * The solution is to create an FPC-managed thread which has the TLS data
- * and use it to handle the console-output (hence it is called Console-Handler)
- *}
-procedure ConsoleWriteLn(const msg: string);
-begin
-{$IFDEF CONSOLE}
- {$IFDEF FPC}
- // TODO: check for the main-thread and use a simple _ConsoleWriteLn() then?
- //GetCurrentThreadThreadId();
- System.EnterCriticalSection(ConsoleCriticalSection);
- MessageList.Add(msg);
- RTLeventSetEvent(ConsoleEvent);
- System.LeaveCriticalSection(ConsoleCriticalSection);
- {$ELSE}
- _ConsoleWriteLn(msg);
- {$ENDIF}
-{$ENDIF}
-end;
-
-procedure ShowMessage(const msg: String; msgType: TMessageType);
-{$IFDEF MSWINDOWS}
-var Flags: cardinal;
-{$ENDIF}
-begin
-{$IF Defined(MSWINDOWS)}
- case msgType of
- mtInfo: Flags := MB_ICONINFORMATION or MB_OK;
- mtError: Flags := MB_ICONERROR or MB_OK;
- else Flags := MB_OK;
- end;
- MessageBox(0, PChar(msg), PChar(USDXVersionStr()), Flags);
-{$ELSE}
- ConsoleWriteln(msg);
-{$IFEND}
-end;
-
-(*
- * Recursive part of the MergeSort algorithm.
- * OutList will be either InList or TempList and will be swapped in each
- * depth-level of recursion. By doing this it we can directly merge into the
- * output-list. If we only had In- and OutList parameters we had to merge into
- * InList after the recursive calls and copy the data to the OutList afterwards.
- *)
-procedure _MergeSort(InList, TempList, OutList: TList; StartPos, BlockSize: integer;
- CompareFunc: TListSortCompare);
-var
- LeftSize, RightSize: integer; // number of elements in left/right block
- LeftEnd, RightEnd: integer; // Index after last element in left/right block
- MidPos: integer; // index of first element in right block
- Pos: integer; // position in output list
-begin
- LeftSize := BlockSize div 2;
- RightSize := BlockSize - LeftSize;
- MidPos := StartPos + LeftSize;
-
- // sort left and right halves of this block by recursive calls of this function
- if (LeftSize >= 2) then
- _MergeSort(InList, OutList, TempList, StartPos, LeftSize, CompareFunc)
- else
- TempList[StartPos] := InList[StartPos];
- if (RightSize >= 2) then
- _MergeSort(InList, OutList, TempList, MidPos, RightSize, CompareFunc)
- else
- TempList[MidPos] := InList[MidPos];
-
- // merge sorted left and right sub-lists into output-list
- LeftEnd := MidPos;
- RightEnd := StartPos + BlockSize;
- Pos := StartPos;
- while ((StartPos < LeftEnd) and (MidPos < RightEnd)) do
- begin
- if (CompareFunc(TempList[StartPos], TempList[MidPos]) <= 0) then
- begin
- OutList[Pos] := TempList[StartPos];
- Inc(StartPos);
- end
- else
- begin
- OutList[Pos] := TempList[MidPos];
- Inc(MidPos);
- end;
- Inc(Pos);
- end;
-
- // copy remaining elements to output-list
- while (StartPos < LeftEnd) do
- begin
- OutList[Pos] := TempList[StartPos];
- Inc(StartPos);
- Inc(Pos);
- end;
- while (MidPos < RightEnd) do
- begin
- OutList[Pos] := TempList[MidPos];
- Inc(MidPos);
- Inc(Pos);
- end;
-end;
-
-(*
- * Stable alternative to the instable TList.Sort() (uses QuickSort) implementation.
- * A stable sorting algorithm preserves preordered items. E.g. if sorting by
- * songs by title first and artist afterwards, the songs of each artist will
- * be ordered by title. In contrast to this an unstable algorithm (like QuickSort)
- * may destroy an existing order, so the songs of an artist will not be ordered
- * by title anymore after sorting by artist in the previous example.
- * If you do not need a stable algorithm, use TList.Sort() instead.
- *)
-procedure MergeSort(List: TList; CompareFunc: TListSortCompare);
-var
- TempList: TList;
-begin
- TempList := TList.Create();
- TempList.Count := List.Count;
- if (List.Count >= 2) then
- _MergeSort(List, TempList, List, 0, List.Count, CompareFunc);
- TempList.Free;
-end;
-
-
-type
- // stores the unaligned pointer of data allocated by GetAlignedMem()
- PMemAlignHeader = ^TMemAlignHeader;
- TMemAlignHeader = pointer;
-
-(**
- * Use this function to assure that allocated memory is aligned on a specific
- * byte boundary.
- * Alignment must be a power of 2.
- *
- * Important: Memory allocated with GetAlignedMem() MUST be freed with
- * FreeAlignedMem(), FreeMem() will cause a segmentation fault.
- *
- * Hint: If you do not need dynamic memory, consider to allocate memory
- * statically and use the {$ALIGN x} compiler directive. Note that delphi
- * supports an alignment "x" of up to 8 bytes only whereas FPC supports
- * alignments on 16 and 32 byte boundaries too.
- *)
-{$WARNINGS OFF}
-function GetAlignedMem(Size: cardinal; Alignment: integer): pointer;
-var
- OrigPtr: pointer;
-const
- MIN_ALIGNMENT = 16;
-begin
- // Delphi and FPC (tested with 2.2.0) align memory blocks allocated with
- // GetMem() at least on 8 byte boundaries. Delphi uses a minimal alignment
- // of either 8 or 16 bytes depending on the size of the requested block
- // (see System.GetMinimumBlockAlignment). As we do not want to change the
- // boundary for the worse, we align at least on MIN_ALIGN.
- if (Alignment < MIN_ALIGNMENT) then
- Alignment := MIN_ALIGNMENT;
-
- // allocate unaligned memory
- GetMem(OrigPtr, SizeOf(TMemAlignHeader) + Size + Alignment);
- if (OrigPtr = nil) then
- begin
- Result := nil;
- Exit;
- end;
-
- // reserve space for the header
- Result := pointer(PtrUInt(OrigPtr) + SizeOf(TMemAlignHeader));
- // align memory
- Result := pointer(PtrUInt(Result) + Alignment - PtrUInt(Result) mod Alignment);
-
- // set header with info on old pointer for FreeMem
- PMemAlignHeader(PtrUInt(Result) - SizeOf(TMemAlignHeader))^ := OrigPtr;
-end;
-{$WARNINGS ON}
-
-{$WARNINGS OFF}
-procedure FreeAlignedMem(P: pointer);
-begin
- if (P <> nil) then
- FreeMem(PMemAlignHeader(PtrUInt(P) - SizeOf(TMemAlignHeader))^);
-end;
-{$WARNINGS ON}
-
-
-initialization
- InitConsoleOutput();
-
-finalization
- FinalizeConsoleOutput();
-
-end.
diff --git a/src/base/UConfig.pas b/src/base/UConfig.pas
deleted file mode 100644
index f6dc69a5..00000000
--- a/src/base/UConfig.pas
+++ /dev/null
@@ -1,232 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UConfig;
-
-// -------------------------------------------------------------------
-// Note on version comparison (for developers only):
-// -------------------------------------------------------------------
-// Delphi (in contrast to FPC) DOESN'T support MACROS. So we
-// can't define a macro like VERSION_MAJOR(version) to extract
-// parts of the version-number or to create version numbers for
-// comparison purposes as with a MAKE_VERSION(maj, min, rev) macro.
-// So we have to define constants for every part of the version here.
-//
-// In addition FPC (in contrast to delphi) DOES NOT support floating-
-// point numbers in $IF compiler-directives (e.g. {$IF VERSION > 1.23})
-// It also DOESN'T support arithmetic operations so we aren't able to
-// compare versions this way (brackets aren't supported too):
-// {$IF VERSION > ((VER_MAJ*2)+(VER_MIN*23)+(VER_REL*1))}
-//
-// Hence we have to use fixed numbers in the directives. At least
-// Pascal allows leading 0s so 0005 equals 5 (octals are
-// preceded by & and not by 0 in FPC).
-// We also fix the count of digits for each part of the version number
-// to 3 (aaaiiirrr with aaa=major, iii=minor, rrr=release version)
-//
-// A check for a library with at least a version of 2.5.11 would look
-// like this:
-// {$IF LIB_VERSION >= 002005011}
-//
-// If you just need to check the major version do this:
-// {$IF LIB_VERSION_MAJOR >= 23}
-//
-// IMPORTANT:
-// Because this unit must be included in a uses-section it is
-// not possible to use the version-numbers in this uses-clause.
-// Example:
-// interface
-// uses
-// versions, // include this file
-// {$IF USE_UNIT_XYZ}xyz;{$IFEND} // Error: USE_UNIT_XYZ not defined
-// const
-// {$IF USE_UNIT_XYZ}test = 2;{$IFEND} // OK
-// uses
-// {$IF USE_UNIT_XYZ}xyz;{$IFEND} // OK
-//
-// Even if this file was an include-file no constants could be declared
-// before the interface's uses clause.
-// In FPC macros {$DEFINE VER:= 3} could be used to declare the version-numbers
-// but this is incompatible to Delphi. In addition macros do not allow expand
-// arithmetic expressions. Although you can define
-// {$DEFINE FPC_VER:= FPC_VERSION*1000000+FPC_RELEASE*1000+FPC_PATCH}
-// the following check would fail:
-// {$IF FPC_VERSION_INT >= 002002000}
-// would fail because FPC_VERSION_INT is interpreted as a string.
-//
-// PLEASE consider this if you use version numbers in $IF compiler-
-// directives. Otherwise you might break portability.
-// -------------------------------------------------------------------
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
- {$MACRO ON} // for evaluation of FPC_VERSION/RELEASE/PATCH
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- SysUtils;
-
-const
- // IMPORTANT:
- // If IncludeConstants is defined, the const-sections
- // of the config-file will be included too.
- // This switch is necessary because it is not possible to
- // include the const-sections in the switches.inc.
- // switches.inc is always included before the first uses-
- // section but at that place no const-section is allowed.
- // So we have to include the config-file in switches.inc
- // with IncludeConstants undefined and in UConfig.pas with
- // IncludeConstants defined (see the note above).
- {$DEFINE IncludeConstants}
-
- // include config-file (defines + constants)
- {$IF Defined(MSWindows)}
- {$I ..\config-win.inc}
- {$ELSEIF Defined(Linux)}
- {$I ../config-linux.inc}
- {$ELSEIF Defined(FreeBSD)}
- {$I ../config-freebsd.inc}
- {$ELSEIF Defined(Darwin)}
- {$I ../config-darwin.inc}
- {$ELSE}
- {$MESSAGE Fatal 'Unknown OS'}
- {$IFEND}
-
-{* Libraries *}
-
- VERSION_MAJOR = 1000000;
- VERSION_MINOR = 1000;
- VERSION_RELEASE = 1;
-
- (*
- * Current version of UltraStar Deluxe
- *)
- USDX_VERSION_MAJOR = 1;
- USDX_VERSION_MINOR = 1;
- USDX_VERSION_RELEASE = 0;
- USDX_VERSION_STATE = 'Alpha';
- USDX_STRING = 'UltraStar Deluxe';
-
- (*
- * FPC version numbers are already defined as built-in macros:
- * FPC_VERSION (MAJOR)
- * FPC_RELEASE (MINOR)
- * FPC_PATCH (RELEASE)
- * Since FPC_VERSION is already defined, we will use FPC_VERSION_INT as
- * composed version number.
- *)
- {$IFNDEF FPC}
- // Delphi 7 evaluates every $IF-directive even if it is disabled by a surrounding
- // $IF or $IFDEF so the follwing will give you an error in delphi:
- // {$IFDEF FPC}{$IF (FPC_VERSION > 2)}...{$IFEND}{$ENDIF}
- // The reason for this error is that FPC_VERSION is not a valid constant.
- // To avoid this error, we define dummys here.
- FPC_VERSION = 0;
- FPC_RELEASE = 0;
- FPC_PATCH = 0;
- {$ENDIF}
-
- FPC_VERSION_INT = (FPC_VERSION * VERSION_MAJOR) +
- (FPC_RELEASE * VERSION_MINOR) +
- (FPC_PATCH * VERSION_RELEASE);
-
- // FPC 2.2.0 unicode support is very buggy. The cwstring unit for example
- // always crashes whenever UTF8ToAnsi() is called on a non UTF8 encoded string
- // what is fixed in 2.2.2.
- {$IF Defined(FPC) and (FPC_VERSION_INT < 2002002)} // < 2.2.2
- {$MESSAGE FATAL 'FPC >= 2.2.2 required!'}
- {$IFEND}
-
- {$IFDEF HaveFFmpeg}
-
- LIBAVCODEC_VERSION = (LIBAVCODEC_VERSION_MAJOR * VERSION_MAJOR) +
- (LIBAVCODEC_VERSION_MINOR * VERSION_MINOR) +
- (LIBAVCODEC_VERSION_RELEASE * VERSION_RELEASE);
-
- LIBAVFORMAT_VERSION = (LIBAVFORMAT_VERSION_MAJOR * VERSION_MAJOR) +
- (LIBAVFORMAT_VERSION_MINOR * VERSION_MINOR) +
- (LIBAVFORMAT_VERSION_RELEASE * VERSION_RELEASE);
-
- LIBAVUTIL_VERSION = (LIBAVUTIL_VERSION_MAJOR * VERSION_MAJOR) +
- (LIBAVUTIL_VERSION_MINOR * VERSION_MINOR) +
- (LIBAVUTIL_VERSION_RELEASE * VERSION_RELEASE);
-
- {$IFDEF HaveSWScale}
- LIBSWSCALE_VERSION = (LIBSWSCALE_VERSION_MAJOR * VERSION_MAJOR) +
- (LIBSWSCALE_VERSION_MINOR * VERSION_MINOR) +
- (LIBSWSCALE_VERSION_RELEASE * VERSION_RELEASE);
- {$ENDIF}
-
- {$ENDIF}
-
- {$IFDEF HaveProjectM}
- PROJECTM_VERSION = (PROJECTM_VERSION_MAJOR * VERSION_MAJOR) +
- (PROJECTM_VERSION_MINOR * VERSION_MINOR) +
- (PROJECTM_VERSION_RELEASE * VERSION_RELEASE);
- {$ENDIF}
-
- {$IFDEF HavePortaudio}
- PORTAUDIO_VERSION = (PORTAUDIO_VERSION_MAJOR * VERSION_MAJOR) +
- (PORTAUDIO_VERSION_MINOR * VERSION_MINOR) +
- (PORTAUDIO_VERSION_RELEASE * VERSION_RELEASE);
- {$ENDIF}
-
- {$IFDEF HaveLibsamplerate}
- LIBSAMPLERATE_VERSION = (LIBSAMPLERATE_VERSION_MAJOR * VERSION_MAJOR) +
- (LIBSAMPLERATE_VERSION_MINOR * VERSION_MINOR) +
- (LIBSAMPLERATE_VERSION_RELEASE * VERSION_RELEASE);
- {$ENDIF}
-
-function USDXVersionStr(): string;
-function USDXShortVersionStr(): string;
-
-implementation
-
-uses
- StrUtils, Math;
-
-function USDXShortVersionStr(): string;
-begin
- Result :=
- USDX_STRING +
- IfThen(USDX_VERSION_STATE <> '', ' '+USDX_VERSION_STATE);
-end;
-
-function USDXVersionStr(): string;
-begin
- Result :=
- USDX_STRING + ' V ' +
- IntToStr(USDX_VERSION_MAJOR) + '.' +
- IntToStr(USDX_VERSION_MINOR) + '.' +
- IntToStr(USDX_VERSION_RELEASE) +
- IfThen(USDX_VERSION_STATE <> '', ' '+USDX_VERSION_STATE) +
- ' Build';
-end;
-
-end.
diff --git a/src/base/UCovers.pas b/src/base/UCovers.pas
deleted file mode 100644
index 6c7c9e48..00000000
--- a/src/base/UCovers.pas
+++ /dev/null
@@ -1,459 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UCovers;
-
-{
- TODO:
- - adjust database to new song-loading (e.g. use SongIDs)
- - support for deletion of outdated covers
- - support for update of changed covers
- - use paths relative to the song for removable disks support
- (a drive might have a different drive-name the next time it is connected,
- so "H:/songs/..." will not match "I:/songs/...")
-}
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- SDL,
- SQLite3,
- SQLiteTable3,
- SysUtils,
- Classes,
- UImage,
- UTexture,
- UPath;
-
-type
- ECoverDBException = class(Exception)
- end;
-
- TCover = class
- private
- ID: int64;
- Filename: IPath;
- public
- constructor Create(ID: int64; Filename: IPath);
- function GetPreviewTexture(): TTexture;
- function GetTexture(): TTexture;
- end;
-
- TThumbnailInfo = record
- CoverWidth: integer; // Original width of cover
- CoverHeight: integer; // Original height of cover
- PixelFormat: TImagePixelFmt; // Pixel-format of thumbnail
- end;
-
- TCoverDatabase = class
- private
- DB: TSQLiteDatabase;
- procedure InitCoverDatabase();
- function CreateThumbnail(const Filename: IPath; var Info: TThumbnailInfo): PSDL_Surface;
- function LoadCover(CoverID: int64): TTexture;
- procedure DeleteCover(CoverID: int64);
- function FindCoverIntern(const Filename: IPath): int64;
- procedure Open();
- function GetVersion(): integer;
- procedure SetVersion(Version: integer);
- public
- constructor Create();
- destructor Destroy; override;
- function AddCover(const Filename: IPath): TCover;
- function FindCover(const Filename: IPath): TCover;
- function CoverExists(const Filename: IPath): boolean;
- function GetMaxCoverSize(): integer;
- procedure SetMaxCoverSize(Size: integer);
- end;
-
- TBlobWrapper = class(TCustomMemoryStream)
- function Write(const Buffer; Count: Integer): Integer; override;
- end;
-
-var
- Covers: TCoverDatabase;
-
-implementation
-
-uses
- UMain,
- ULog,
- UPlatform,
- UIni,
- Math,
- DateUtils;
-
-const
- COVERDB_FILENAME: UTF8String = 'cover.db';
- COVERDB_VERSION = 01; // 0.1
- COVER_TBL = 'Cover';
- COVER_THUMBNAIL_TBL = 'CoverThumbnail';
- COVER_IDX = 'Cover_Filename_IDX';
-
-// Note: DateUtils.DateTimeToUnix() will throw an exception in FPC
-function DateTimeToUnixTime(time: TDateTime): int64;
-begin
- Result := Round((time - UnixDateDelta) * SecsPerDay);
-end;
-
-// Note: DateUtils.UnixToDateTime() will throw an exception in FPC
-function UnixTimeToDateTime(timestamp: int64): TDateTime;
-begin
- Result := timestamp / SecsPerDay + UnixDateDelta;
-end;
-
-
-{ TBlobWrapper }
-
-function TBlobWrapper.Write(const Buffer; Count: Integer): Integer;
-begin
- SetPointer(Pointer(Buffer), Count);
- Result := Count;
-end;
-
-
-{ TCover }
-
-constructor TCover.Create(ID: int64; Filename: IPath);
-begin
- Self.ID := ID;
- Self.Filename := Filename;
-end;
-
-function TCover.GetPreviewTexture(): TTexture;
-begin
- Result := Covers.LoadCover(ID);
-end;
-
-function TCover.GetTexture(): TTexture;
-begin
- Result := Texture.LoadTexture(Filename);
-end;
-
-
-{ TCoverDatabase }
-
-constructor TCoverDatabase.Create();
-begin
- inherited;
-
- Open();
- InitCoverDatabase();
-end;
-
-destructor TCoverDatabase.Destroy;
-begin
- DB.Free;
- inherited;
-end;
-
-function TCoverDatabase.GetVersion(): integer;
-begin
- Result := DB.GetTableValue('PRAGMA user_version');
-end;
-
-procedure TCoverDatabase.SetVersion(Version: integer);
-begin
- DB.ExecSQL(Format('PRAGMA user_version = %d', [Version]));
-end;
-
-function TCoverDatabase.GetMaxCoverSize(): integer;
-begin
- Result := ITextureSizeVals[Ini.TextureSize];
-end;
-
-procedure TCoverDatabase.SetMaxCoverSize(Size: integer);
-var
- I: integer;
-begin
- // search for first valid cover-size > Size
- for I := 0 to Length(ITextureSizeVals)-1 do
- begin
- if (Size <= ITextureSizeVals[I]) then
- begin
- Ini.TextureSize := I;
- Exit;
- end;
- end;
-
- // fall-back to highest size
- Ini.TextureSize := High(ITextureSizeVals);
-end;
-
-procedure TCoverDatabase.Open();
-var
- Version: integer;
- Filename: IPath;
-begin
- Filename := Platform.GetGameUserPath().Append(COVERDB_FILENAME);
-
- DB := TSQLiteDatabase.Create(Filename.ToUTF8());
- Version := GetVersion();
-
- // check version, if version is too old/new, delete database file
- if ((Version <> 0) and (Version <> COVERDB_VERSION)) then
- begin
- Log.LogInfo('Outdated cover-database file found', 'TCoverDatabase.Open');
- // close and delete outdated file
- DB.Free;
- if (not Filename.DeleteFile()) then
- raise ECoverDBException.Create('Could not delete ' + Filename.ToNative);
- // reopen
- DB := TSQLiteDatabase.Create(Filename.ToUTF8());
- Version := 0;
- end;
-
- // set version number after creation
- if (Version = 0) then
- SetVersion(COVERDB_VERSION);
-
- // speed-up disk-writing. The default FULL-synchronous mode is too slow.
- // With this option disk-writing is approx. 4 times faster but the database
- // might be corrupted if the OS crashes, although this is very unlikely.
- DB.ExecSQL('PRAGMA synchronous = OFF;');
-
- // the next line rather gives a slow-down instead of a speed-up, so we do not use it
- //DB.ExecSQL('PRAGMA temp_store = MEMORY;');
-end;
-
-procedure TCoverDatabase.InitCoverDatabase();
-begin
- DB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+COVER_TBL+'] (' +
- '[ID] INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, ' +
- '[Filename] TEXT UNIQUE NOT NULL, ' +
- '[Date] INTEGER NOT NULL, ' +
- '[Width] INTEGER NOT NULL, ' +
- '[Height] INTEGER NOT NULL ' +
- ')');
-
- DB.ExecSQL('CREATE INDEX IF NOT EXISTS ['+COVER_IDX+'] ON ['+COVER_TBL+'](' +
- '[Filename] ASC' +
- ')');
-
- DB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+COVER_THUMBNAIL_TBL+'] (' +
- '[ID] INTEGER NOT NULL PRIMARY KEY, ' +
- '[Format] INTEGER NOT NULL, ' +
- '[Width] INTEGER NOT NULL, ' +
- '[Height] INTEGER NOT NULL, ' +
- '[Data] BLOB NULL' +
- ')');
-end;
-
-function TCoverDatabase.FindCoverIntern(const Filename: IPath): int64;
-begin
- Result := DB.GetTableValue('SELECT [ID] FROM ['+COVER_TBL+'] ' +
- 'WHERE [Filename] = ?',
- [Filename.ToUTF8]);
-end;
-
-function TCoverDatabase.FindCover(const Filename: IPath): TCover;
-var
- CoverID: int64;
-begin
- Result := nil;
- try
- CoverID := FindCoverIntern(Filename);
- if (CoverID > 0) then
- Result := TCover.Create(CoverID, Filename);
- except on E: Exception do
- Log.LogError(E.Message, 'TCoverDatabase.FindCover');
- end;
-end;
-
-function TCoverDatabase.CoverExists(const Filename: IPath): boolean;
-begin
- Result := false;
- try
- Result := (FindCoverIntern(Filename) > 0);
- except on E: Exception do
- Log.LogError(E.Message, 'TCoverDatabase.CoverExists');
- end;
-end;
-
-function TCoverDatabase.AddCover(const Filename: IPath): TCover;
-var
- CoverID: int64;
- Thumbnail: PSDL_Surface;
- CoverData: TBlobWrapper;
- FileDate: TDateTime;
- Info: TThumbnailInfo;
-begin
- Result := nil;
-
- //if (not FileExists(Filename)) then
- // Exit;
-
- // TODO: replace '\' with '/' in filename
- FileDate := Now(); //FileDateToDateTime(FileAge(Filename));
-
- Thumbnail := CreateThumbnail(Filename, Info);
- if (Thumbnail = nil) then
- Exit;
-
- CoverData := TBlobWrapper.Create;
- CoverData.Write(Thumbnail^.pixels, Thumbnail^.h * Thumbnail^.pitch);
-
- try
- // Note: use a transaction to speed-up file-writing.
- // Without data written by the first INSERT might be moved at the second INSERT.
- DB.BeginTransaction();
-
- // add general cover info
- DB.ExecSQL('INSERT INTO ['+COVER_TBL+'] ' +
- '([Filename], [Date], [Width], [Height]) VALUES' +
- '(?, ?, ?, ?)',
- [Filename.ToUTF8, DateTimeToUnixTime(FileDate),
- Info.CoverWidth, Info.CoverHeight]);
-
- // get auto-generated cover ID
- CoverID := DB.GetLastInsertRowID();
-
- // add thumbnail info
- DB.ExecSQL('INSERT INTO ['+COVER_THUMBNAIL_TBL+'] ' +
- '([ID], [Format], [Width], [Height], [Data]) VALUES' +
- '(?, ?, ?, ?, ?)',
- [CoverID, Ord(Info.PixelFormat),
- Thumbnail^.w, Thumbnail^.h, CoverData]);
-
- Result := TCover.Create(CoverID, Filename);
- except on E: Exception do
- Log.LogError(E.Message, 'TCoverDatabase.AddCover');
- end;
-
- DB.Commit();
- CoverData.Free;
- SDL_FreeSurface(Thumbnail);
-end;
-
-function TCoverDatabase.LoadCover(CoverID: int64): TTexture;
-var
- Width, Height: integer;
- PixelFmt: TImagePixelFmt;
- Data: PChar;
- DataSize: integer;
- Filename: IPath;
- Table: TSQLiteUniTable;
-begin
- Table := nil;
-
- try
- Table := DB.GetUniTable(Format(
- 'SELECT C.[Filename], T.[Format], T.[Width], T.[Height], T.[Data] ' +
- 'FROM ['+COVER_TBL+'] C ' +
- 'INNER JOIN ['+COVER_THUMBNAIL_TBL+'] T ' +
- 'USING(ID) ' +
- 'WHERE [ID] = %d', [CoverID]));
-
- Filename := Path(Table.FieldAsString(0));
- PixelFmt := TImagePixelFmt(Table.FieldAsInteger(1));
- Width := Table.FieldAsInteger(2);
- Height := Table.FieldAsInteger(3);
-
- Data := Table.FieldAsBlobPtr(4, DataSize);
- if (Data <> nil) and
- (PixelFmt = ipfRGB) then
- begin
- Result := Texture.CreateTexture(Data, Filename, Width, Height, 24)
- end
- else
- begin
- // FillChar() does not decrement the ref-count of ref-counted fields
- // -> reset Name field manually
- Result.Name := nil;
- FillChar(Result, SizeOf(TTexture), 0);
- end;
- except on E: Exception do
- Log.LogError(E.Message, 'TCoverDatabase.LoadCover');
- end;
-
- Table.Free;
-end;
-
-procedure TCoverDatabase.DeleteCover(CoverID: int64);
-begin
- DB.ExecSQL(Format('DELETE FROM ['+COVER_TBL+'] WHERE [ID] = %d', [CoverID]));
- DB.ExecSQL(Format('DELETE FROM ['+COVER_THUMBNAIL_TBL+'] WHERE [ID] = %d', [CoverID]));
-end;
-
-(**
- * Returns a pointer to an array of bytes containing the texture data in the
- * requested size
- *)
-function TCoverDatabase.CreateThumbnail(const Filename: IPath; var Info: TThumbnailInfo): PSDL_Surface;
-var
- //TargetAspect, SourceAspect: double;
- //TargetWidth, TargetHeight: integer;
- Thumbnail: PSDL_Surface;
- MaxSize: integer;
-begin
- Result := nil;
-
- MaxSize := GetMaxCoverSize();
-
- Thumbnail := LoadImage(Filename);
- if (not assigned(Thumbnail)) then
- begin
- Log.LogError('Could not load cover: "'+ Filename.ToNative +'"', 'TCoverDatabase.AddCover');
- Exit;
- end;
-
- // Convert pixel format as needed
- AdjustPixelFormat(Thumbnail, TEXTURE_TYPE_PLAIN);
-
- Info.CoverWidth := Thumbnail^.w;
- Info.CoverHeight := Thumbnail^.h;
- Info.PixelFormat := ipfRGB;
-
- (* TODO: keep aspect ratio
- TargetAspect := Width / Height;
- SourceAspect := TexSurface.w / TexSurface.h;
-
- // Scale texture to covers dimensions (keep aspect)
- if (SourceAspect >= TargetAspect) then
- begin
- TargetWidth := Width;
- TargetHeight := Trunc(Width / SourceAspect);
- end
- else
- begin
- TargetHeight := Height;
- TargetWidth := Trunc(Height * SourceAspect);
- end;
- *)
-
- // TODO: do not scale if image is smaller
- ScaleImage(Thumbnail, MaxSize, MaxSize);
-
- Result := Thumbnail;
-end;
-
-end.
-
diff --git a/src/base/UDLLManager.pas b/src/base/UDLLManager.pas
deleted file mode 100644
index d5bb1480..00000000
--- a/src/base/UDLLManager.pas
+++ /dev/null
@@ -1,293 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UDLLManager;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- ModiSDK,
- UFiles,
- UPath,
- UFilesystem;
-
-type
- TDLLMan = class
- private
- hLib: THandle;
- P_Init: fModi_Init;
- P_Draw: fModi_Draw;
- P_Finish: fModi_Finish;
- P_RData: pModi_RData;
- public
- Plugins: array of TPluginInfo;
- PluginPaths: array of IPath;
- Selected: ^TPluginInfo;
-
- constructor Create;
-
- procedure GetPluginList;
- procedure ClearPluginInfo(No: cardinal);
- function LoadPluginInfo(const Filename: IPath; No: cardinal): boolean;
-
- function LoadPlugin(No: cardinal): boolean;
- procedure UnLoadPlugin;
-
- function PluginInit (const TeamInfo: TTeamInfo;
- var Playerinfo: TPlayerinfo;
- const Sentences: TSentences;
- const LoadTex: fModi_LoadTex;
- const Print: fModi_Print;
- LoadSound: fModi_LoadSound;
- PlaySound: pModi_PlaySound)
- : boolean;
- function PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: cardinal): boolean;
- function PluginFinish (var Playerinfo: TPlayerinfo): byte;
- procedure PluginRData (handle: HSTREAM; buffer: Pointer; len: dword; user: dword);
- end;
-
-var
- DLLMan: TDLLMan;
-
-const
-{$IF Defined(MSWINDOWS)}
- DLLExt = '.dll';
-{$ELSEIF Defined(DARWIN)}
- DLLExt = '.dylib';
-{$ELSEIF Defined(UNIX)}
- DLLExt = '.so';
-{$IFEND}
-
-implementation
-
-uses
- {$IFDEF MSWINDOWS}
- windows,
- {$ELSE}
- dynlibs,
- {$ENDIF}
- UPathUtils,
- ULog,
- SysUtils;
-
-
-constructor TDLLMan.Create;
-begin
- inherited;
- SetLength(Plugins, 0);
- SetLength(PluginPaths, Length(Plugins));
- GetPluginList;
-end;
-
-procedure TDLLMan.GetPluginList;
-var
- Iter: IFileIterator;
- FileInfo: TFileInfo;
-begin
- Iter := FileSystem.FileFind(PluginPath.Append('*' + DLLExt), 0);
- while (Iter.HasNext) do
- begin
- SetLength(Plugins, Length(Plugins)+1);
- SetLength(PluginPaths, Length(Plugins));
-
- FileInfo := Iter.Next;
-
- if LoadPluginInfo(FileInfo.Name, High(Plugins)) then // loaded succesful
- begin
- PluginPaths[High(PluginPaths)] := FileInfo.Name;
- end
- else // error loading
- begin
- SetLength(Plugins, Length(Plugins)-1);
- SetLength(PluginPaths, Length(Plugins));
- end;
- end;
-end;
-
-procedure TDLLMan.ClearPluginInfo(No: cardinal);
-begin
-// set to party modi plugin
- Plugins[No].Typ := 8;
-
- Plugins[No].Name := 'unknown';
- Plugins[No].NumPlayers := 0;
-
- Plugins[No].Creator := 'Nobody';
- Plugins[No].PluginDesc := 'NO_PLUGIN_DESC';
-
- Plugins[No].LoadSong := true;
- Plugins[No].ShowScore := true;
- Plugins[No].ShowBars := true;
- Plugins[No].ShowNotes := true;
- Plugins[No].LoadVideo := true;
- Plugins[No].LoadBack := true;
-
- Plugins[No].TeamModeOnly := true;
- Plugins[No].GetSoundData := true;
- Plugins[No].Dummy := true;
-
-
- Plugins[No].BGShowFull := true;
- Plugins[No].BGShowFull_O := true;
-
- Plugins[No].ShowRateBar := true;
- Plugins[No].ShowRateBar_O := true;
-
- Plugins[No].EnLineBonus := true;
- Plugins[No].EnLineBonus_O := true;
-end;
-
-function TDLLMan.LoadPluginInfo(const Filename: IPath; No: cardinal): boolean;
-var
- hLibg: THandle;
- Info: pModi_PluginInfo;
-// I: integer;
-begin
- Result := true;
-// clear plugin info
- ClearPluginInfo(No);
-
-{
-// workaround plugins loaded 2 times
- for i := low(pluginpaths) to high(pluginpaths) do
- if (pluginpaths[i] = filename) then
- exit;
-}
-
-// load libary
- hLibg := LoadLibrary(PChar(PluginPath.Append(Filename).ToNative));
-// if loaded
- if (hLibg <> 0) then
- begin
-// load info procedure
- @Info := GetProcAddress(hLibg, PChar('PluginInfo'));
-
-// if loaded
- if (@Info <> nil) then
- begin
-// load plugininfo
- Info(Plugins[No]);
- Result := true;
- end
- else
- Log.LogError('Could not load plugin "' + Filename.ToNative + '": Info procedure not found');
-
- FreeLibrary (hLibg);
- end
- else
- Log.LogError('Could not load plugin "' + Filename.ToNative + '": Libary not loaded');
-end;
-
-function TDLLMan.LoadPlugin(No: cardinal): boolean;
-begin
- Result := true;
-// load libary
- hLib := LoadLibrary(PChar(PluginPath.Append(PluginPaths[No]).ToNative));
-// if loaded
- if (hLib <> 0) then
- begin
-// load info procedure
- @P_Init := GetProcAddress (hLib, 'Init');
- @P_Draw := GetProcAddress (hLib, 'Draw');
- @P_Finish := GetProcAddress (hLib, 'Finish');
-
-// if loaded
- if (@P_Init <> nil) and (@P_Draw <> nil) and (@P_Finish <> nil) then
- begin
- Selected := @Plugins[No];
- Result := true;
- end
- else
- begin
- Log.LogError('Could not load plugin "' + PluginPaths[No].ToNative + '": Procedures not found');
- end;
- end
- else
- Log.LogError('Could not load plugin "' + PluginPaths[No].ToNative + '": Libary not loaded');
-end;
-
-procedure TDLLMan.UnLoadPlugin;
-begin
- if (hLib <> 0) then
- FreeLibrary (hLib);
-
-// Selected := nil;
- @P_Init := nil;
- @P_Draw := nil;
- @P_Finish := nil;
- @P_RData := nil;
-end;
-
-function TDLLMan.PluginInit (const TeamInfo: TTeamInfo;
- var Playerinfo: TPlayerinfo;
- const Sentences: TSentences;
- const LoadTex: fModi_LoadTex;
- const Print: fModi_Print;
- LoadSound: fModi_LoadSound;
- PlaySound: pModi_PlaySound)
- : boolean;
-var
- Methods: TMethodRec;
-begin
- Methods.LoadTex := LoadTex;
- Methods.Print := Print;
- Methods.LoadSound := LoadSound;
- Methods.PlaySound := PlaySound;
-
- if (@P_Init <> nil) then
- Result := P_Init (TeamInfo, PlayerInfo, Sentences, Methods)
- else
- Result := true
-end;
-
-function TDLLMan.PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: cardinal): boolean;
-begin
- if (@P_Draw <> nil) then
- Result := P_Draw (PlayerInfo, CurSentence)
- else
- Result := true
-end;
-
-function TDLLMan.PluginFinish (var Playerinfo: TPlayerinfo): byte;
-begin
- if (@P_Finish <> nil) then
- Result := P_Finish (PlayerInfo)
- else
- Result := 0;
-end;
-
-procedure TDLLMan.PluginRData (handle: HStream; buffer: Pointer; len: dword; user: dword);
-begin
-if (@P_RData <> nil) then
- P_RData (handle, buffer, len, user);
-end;
-
-end.
diff --git a/src/base/UDataBase.pas b/src/base/UDataBase.pas
deleted file mode 100644
index 85b4b8e8..00000000
--- a/src/base/UDataBase.pas
+++ /dev/null
@@ -1,614 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UDataBase;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- Classes,
- SQLiteTable3,
- UPath,
- USong,
- USongs;
-
-//--------------------
-//DataBaseSystem - Class including all DB methods
-//--------------------
-type
- TStatType = (
- stBestScores, // Best scores
- stBestSingers, // Best singers
- stMostSungSong, // Most sung songs
- stMostPopBand // Most popular band
- );
-
- // abstract super-class for statistic results
- TStatResult = class
- public
- Typ: TStatType;
- end;
-
- TStatResultBestScores = class(TStatResult)
- public
- Singer: UTF8String;
- Score: word;
- Difficulty: byte;
- SongArtist: UTF8String;
- SongTitle: UTF8String;
- Date: UTF8String;
- end;
-
- TStatResultBestSingers = class(TStatResult)
- public
- Player: UTF8String;
- AverageScore: word;
- end;
-
- TStatResultMostSungSong = class(TStatResult)
- public
- Artist: UTF8String;
- Title: UTF8String;
- TimesSung: word;
- end;
-
- TStatResultMostPopBand = class(TStatResult)
- public
- ArtistName: UTF8String;
- TimesSungTot: word;
- end;
-
-
- TDataBaseSystem = class
- private
- ScoreDB: TSQLiteDatabase;
- fFilename: IPath;
-
- function GetVersion(): integer;
- procedure SetVersion(Version: integer);
- public
- property Filename: IPath read fFilename;
-
- destructor Destroy; override;
-
- procedure Init(const Filename: IPath);
- procedure ReadScore(Song: TSong);
- procedure AddScore(Song: TSong; Level: integer; const Name: UTF8String; Score: integer);
- procedure WriteScore(Song: TSong);
-
- function GetStats(Typ: TStatType; Count: byte; Page: cardinal; Reversed: boolean): TList;
- procedure FreeStats(StatList: TList);
- function GetTotalEntrys(Typ: TStatType): cardinal;
- function GetStatReset: TDateTime;
- function FormatDate(time_stamp: integer): UTF8String;
- end;
-
-var
- DataBase: TDataBaseSystem;
-
-implementation
-
-uses
- DateUtils,
- ULanguage,
- StrUtils,
- SysUtils,
- ULog;
-
-{
- cDBVersion - history
- 0 = USDX 1.01 or no Database
- 01 = USDX 1.1
-}
-const
- cDBVersion = 01; // 0.1
- cUS_Scores = 'us_scores';
- cUS_Songs = 'us_songs';
- cUS_Statistics_Info = 'us_statistics_info';
-
-(**
- * Open database and create tables if they do not exist
- *)
-procedure TDataBaseSystem.Init(const Filename: IPath);
-var
- Version: integer;
- finalizeConversion: boolean;
-begin
- if Assigned(ScoreDB) then
- Exit;
-
- Log.LogStatus('Initializing database: "' + Filename.ToNative + '"', 'TDataBaseSystem.Init');
-
- try
-
- // open database
- ScoreDB := TSQLiteDatabase.Create(Filename.ToUTF8);
- fFilename := Filename;
-
- Version := GetVersion();
-
- // add Table cUS_Statistics_Info
- // needed in the conversion from 1.01 to 1.1
- if not ScoreDB.TableExists(cUS_Statistics_Info) then
- begin
- Log.LogInfo('Outdated song database found - missing table"' + cUS_Statistics_Info + '"', 'TDataBaseSystem.Init');
- ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS [' + cUS_Statistics_Info + '] (' +
- '[ResetTime] INTEGER' +
- ');');
- // insert creation timestamp
- ScoreDB.ExecSQL(Format('INSERT INTO [' + cUS_Statistics_Info + '] ' +
- '([ResetTime]) VALUES(%d);',
- [DateTimeToUnix(Now())]));
- end;
-
- // convert data from 1.01 to 1.1
- // part #1 - prearrangement
- finalizeConversion := false;
- if (Version = 0) AND ScoreDB.TableExists('US_Scores') then
- begin
- // rename old tables - to be able to insert new table structures
- ScoreDB.ExecSQL('ALTER TABLE US_Scores RENAME TO us_scores_101;');
- ScoreDB.ExecSQL('ALTER TABLE US_Songs RENAME TO us_songs_101;');
- finalizeConversion := true; // means: conversion has to be done!
- end;
-
- // Set version number after creation
- if (Version = 0) then
- SetVersion(cDBVersion);
-
- // SQLite does not handle VARCHAR(n) or INT(n) as expected.
- // Texts do not have a restricted length, no matter which type is used,
- // so use the native TEXT type. INT(n) is always INTEGER.
- // In addition, SQLiteTable3 will fail if other types than the native SQLite
- // types are used (especially FieldAsInteger). Also take care to write the
- // types in upper-case letters although SQLite does not care about this -
- // SQLiteTable3 is very sensitive in this regard.
- ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS [' + cUS_Scores + '] (' +
- '[SongID] INTEGER NOT NULL, ' +
- '[Difficulty] INTEGER NOT NULL, ' +
- '[Player] TEXT NOT NULL, ' +
- '[Score] INTEGER NOT NULL, ' +
- '[Date] INTEGER NULL' +
- ');');
-
- ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS [' + cUS_Songs + '] (' +
- '[ID] INTEGER PRIMARY KEY, ' +
- '[Artist] TEXT NOT NULL, ' +
- '[Title] TEXT NOT NULL, ' +
- '[TimesPlayed] INTEGER NOT NULL, ' +
- '[Rating] INTEGER NULL' +
- ');');
-
- // convert data from 1.01 to 1.1
- // part #2 - accomplishment
- if finalizeConversion then
- begin
- Log.LogInfo('Outdated song database found - begin conversion from V1.01 to V1.1', 'TDataBaseSystem.Init');
- // insert old values into new db-schemes (/tables)
- ScoreDB.ExecSQL('INSERT INTO ' + cUS_Scores + ' SELECT SongID, Difficulty, Player, Score FROM us_scores_101;');
- ScoreDB.ExecSQL('INSERT INTO ' + cUS_Songs + ' SELECT ID, Artist, Title, TimesPlayed, ''NULL'' FROM us_songs_101;');
- //now drop old tables
- ScoreDB.ExecSQL('DROP TABLE us_scores_101;');
- ScoreDB.ExecSQL('DROP TABLE us_songs_101;');
- end;
-
- // add column rating to cUS_Songs
- // just for users of nightly builds and developers!
- if not ScoreDB.ContainsColumn(cUS_Songs, 'Rating') then
- begin
- Log.LogInfo('Outdated song database found - adding column rating to "' + cUS_Songs + '"', 'TDataBaseSystem.Init');
- ScoreDB.ExecSQL('ALTER TABLE ' + cUS_Songs + ' ADD COLUMN [Rating] INTEGER NULL');
- end;
-
-
- //add column date to cUS-Scores
- if not ScoreDB.ContainsColumn(cUS_Scores, 'Date') then
- begin
- Log.LogInfo('adding column date to "' + cUS_Scores + '"', 'TDataBaseSystem.Init');
- ScoreDB.ExecSQL('ALTER TABLE ' + cUS_Scores + ' ADD COLUMN [Date] INTEGER NULL');
- end;
-
- except
- on E: Exception do
- begin
- Log.LogError(E.Message, 'TDataBaseSystem.Init');
- FreeAndNil(ScoreDB);
- end;
- end;
-
-end;
-
-(**
- * Frees Database
- *)
-destructor TDataBaseSystem.Destroy;
-begin
- Log.LogInfo('TDataBaseSystem.Free', 'TDataBaseSystem.Destroy');
- ScoreDB.Free;
- inherited;
-end;
-
-(**
- * Format a UNIX-Timestamp into DATE (If 0 then '')
- *)
-function TDataBaseSystem.FormatDate(time_stamp: integer): UTF8String;
-var
- Year, Month, Day: word;
-begin
- Result:='';
- try
- if time_stamp<>0 then
- begin
- DecodeDate(UnixToDateTime(time_stamp), Year, Month, Day);
- Result := Format(Language.Translate('STAT_FORMAT_DATE'), [Day, Month, Year]);
- end;
- except
- on E: EConvertError do
- Log.LogError('Error Parsing FormatString "STAT_FORMAT_DATE": ' + E.Message);
- end;
-end;
-
-
-(**
- * Read Scores into SongArray
- *)
-procedure TDataBaseSystem.ReadScore(Song: TSong);
-var
- TableData: TSQLiteUniTable;
- Difficulty: integer;
- I: integer;
- PlayerListed: boolean;
-begin
- if not Assigned(ScoreDB) then
- Exit;
-
- TableData := nil;
- try
- // Search Song in DB
- TableData := ScoreDB.GetUniTable(
- 'SELECT [Difficulty], [Player], [Score], [Date] FROM [' + cUS_Scores + '] ' +
- 'WHERE [SongID] = (' +
- 'SELECT [ID] FROM [' + cUS_Songs + '] ' +
- 'WHERE [Artist] = ? AND [Title] = ? ' +
- 'LIMIT 1) ' +
- 'ORDER BY [Score] DESC;', //no LIMIT! see filter below!
- [Song.Artist, Song.Title]);
-
- // Empty Old Scores
- SetLength(Song.Score[0], 0); //easy
- SetLength(Song.Score[1], 0); //medium
- SetLength(Song.Score[2], 0); //hard
-
- // Go through all Entrys
- while (not TableData.EOF) do
- begin
- // Add one Entry to Array
- Difficulty := TableData.FieldAsInteger(TableData.FieldIndex['Difficulty']);
- if ((Difficulty >= 0) and (Difficulty <= 2)) and
- (Length(Song.Score[Difficulty]) < 5) then
- begin
- //filter player
- PlayerListed:=false;
- if (Length(Song.Score[Difficulty])>0) then
- begin
- for I := 0 to Length(Song.Score[Difficulty]) - 1 do
- begin
- if (Song.Score[Difficulty, I].Name = TableData.FieldByName['Player']) then
- begin
- PlayerListed:=true;
- break;
- end;
- end;
- end;
-
- if not PlayerListed then
- begin
- SetLength(Song.Score[Difficulty], Length(Song.Score[Difficulty]) + 1);
-
- Song.Score[Difficulty, High(Song.Score[Difficulty])].Name :=
- TableData.FieldByName['Player'];
- Song.Score[Difficulty, High(Song.Score[Difficulty])].Score :=
- TableData.FieldAsInteger(TableData.FieldIndex['Score']);
- Song.Score[Difficulty, High(Song.Score[Difficulty])].Date :=
- FormatDate(TableData.FieldAsInteger(TableData.FieldIndex['Date']));
- end;
- end;
-
- TableData.Next;
- end; // while
-
- except
- for Difficulty := 0 to 2 do
- begin
- SetLength(Song.Score[Difficulty], 1);
- Song.Score[Difficulty, 1].Name := 'Error Reading ScoreDB';
- end;
- end;
-
- TableData.Free;
-end;
-
-(**
- * Adds one new score to DB
- *)
-procedure TDataBaseSystem.AddScore(Song: TSong; Level: integer; const Name: UTF8String; Score: integer);
-var
- ID: integer;
- TableData: TSQLiteTable;
-begin
- if not Assigned(ScoreDB) then
- Exit;
-
- // Prevent 0 Scores from being added EDIT: ==> UScreenTop5.pas!
- //if (Score <= 0) then
- // Exit;
-
- TableData := nil;
-
- try
-
- ID := ScoreDB.GetTableValue(
- 'SELECT [ID] FROM [' + cUS_Songs + '] ' +
- 'WHERE [Artist] = ? AND [Title] = ?',
- [Song.Artist, Song.Title]);
- if (ID = 0) then
- begin
- // Create song if it does not exist
- ScoreDB.ExecSQL(
- 'INSERT INTO [' + cUS_Songs + '] ' +
- '([ID], [Artist], [Title], [TimesPlayed]) VALUES ' +
- '(NULL, ?, ?, 0);',
- [Song.Artist, Song.Title]);
- // Get song-ID
- ID := ScoreDB.GetLastInsertRowID();
- end;
- // Create new entry
- ScoreDB.ExecSQL(
- 'INSERT INTO [' + cUS_Scores + '] ' +
- '([SongID] ,[Difficulty], [Player], [Score], [Date]) VALUES ' +
- '(?, ?, ?, ?, ?);',
- [ID, Level, Name, Score, DateTimeToUnix(Now())]);
-
- except on E: Exception do
- Log.LogError(E.Message, 'TDataBaseSystem.AddScore');
- end;
-
- TableData.Free;
-end;
-
-(**
- * Not needed with new system.
- * Used to increment played count
- *)
-procedure TDataBaseSystem.WriteScore(Song: TSong);
-begin
- if not Assigned(ScoreDB) then
- Exit;
-
- try
- // Increase TimesPlayed
- ScoreDB.ExecSQL(
- 'UPDATE [' + cUS_Songs + '] ' +
- 'SET [TimesPlayed] = [TimesPlayed] + 1 ' +
- 'WHERE [Title] = ? AND [Artist] = ?;',
- [Song.Title, Song.Artist]);
- except on E: Exception do
- Log.LogError(E.Message, 'TDataBaseSystem.WriteScore');
- end;
-end;
-
-(**
- * Writes some stats to array.
- * Returns nil if the database is not ready or a list with zero or more statistic
- * entries.
- * Free the result-list with FreeStats() after usage to avoid memory leaks.
- *)
-function TDataBaseSystem.GetStats(Typ: TStatType; Count: byte; Page: cardinal; Reversed: boolean): TList;
-var
- Query: string;
- TableData: TSQLiteUniTable;
- Stat: TStatResult;
-begin
- Result := nil;
-
- if not Assigned(ScoreDB) then
- Exit;
-
- {Todo: Add Prevention that only players with more than 5 scores are selected at type 2}
-
- // Create query
- case Typ of
- stBestScores: begin
- Query := 'SELECT [Player], [Difficulty], [Score], [Artist], [Title], [Date] FROM [' + cUS_Scores + '] ' +
- 'INNER JOIN [' + cUS_Songs + '] ON ([SongID] = [ID]) ORDER BY [Score]';
- end;
- stBestSingers: begin
- Query := 'SELECT [Player], ROUND(AVG([Score])) FROM [' + cUS_Scores + '] ' +
- 'GROUP BY [Player] ORDER BY AVG([Score])';
- end;
- stMostSungSong: begin
- Query := 'SELECT [Artist], [Title], [TimesPlayed] FROM [' + cUS_Songs + '] ' +
- 'ORDER BY [TimesPlayed]';
- end;
- stMostPopBand: begin
- Query := 'SELECT [Artist], SUM([TimesPlayed]) FROM [' + cUS_Songs + '] ' +
- 'GROUP BY [Artist] ORDER BY SUM([TimesPlayed])';
- end;
- end;
-
- // Add order direction
- Query := Query + IfThen(Reversed, ' ASC', ' DESC');
-
- // Add limit
- Query := Query + ' LIMIT ' + InttoStr(Count * Page) + ', ' + InttoStr(Count) + ';';
-
- // Execute query
- try
- TableData := ScoreDB.GetUniTable(Query);
- except
- on E: Exception do
- begin
- Log.LogError(E.Message, 'TDataBaseSystem.GetStats');
- Exit;
- end;
- end;
-
- Result := TList.Create;
- Stat := nil;
-
- // Copy result to stats array
- while not TableData.EOF do
- begin
- case Typ of
- stBestScores: begin
- Stat := TStatResultBestScores.Create;
- with TStatResultBestScores(Stat) do
- begin
- Singer := TableData.Fields[0];
- Difficulty := TableData.FieldAsInteger(1);
- Score := TableData.FieldAsInteger(2);
- SongArtist := TableData.Fields[3];
- SongTitle := TableData.Fields[4];
- Date := FormatDate(TableData.FieldAsInteger(5));
- end;
- end;
- stBestSingers: begin
- Stat := TStatResultBestSingers.Create;
- with TStatResultBestSingers(Stat) do
- begin
- Player := TableData.Fields[0];
- AverageScore := TableData.FieldAsInteger(1);
- end;
- end;
- stMostSungSong: begin
- Stat := TStatResultMostSungSong.Create;
- with TStatResultMostSungSong(Stat) do
- begin
- Artist := TableData.Fields[0];
- Title := TableData.Fields[1];
- TimesSung := TableData.FieldAsInteger(2);
- end;
- end;
- stMostPopBand: begin
- Stat := TStatResultMostPopBand.Create;
- with TStatResultMostPopBand(Stat) do
- begin
- ArtistName := TableData.Fields[0];
- TimesSungTot := TableData.FieldAsInteger(1);
- end;
- end
- else
- Log.LogCritical('Unknown stat-type', 'TDataBaseSystem.GetStats');
- end;
-
- Stat.Typ := Typ;
- Result.Add(Stat);
-
- TableData.Next;
- end;
-
- TableData.Free;
-end;
-
-procedure TDataBaseSystem.FreeStats(StatList: TList);
-var
- Index: integer;
-begin
- if (StatList = nil) then
- Exit;
- for Index := 0 to StatList.Count-1 do
- TStatResult(StatList[Index]).Free;
- StatList.Free;
-end;
-
-(**
- * Gets total number of entrys for a stats query
- *)
-function TDataBaseSystem.GetTotalEntrys(Typ: TStatType): cardinal;
-var
- Query: string;
-begin
- Result := 0;
-
- if not Assigned(ScoreDB) then
- Exit;
-
- try
- // Create query
- case Typ of
- stBestScores:
- Query := 'SELECT COUNT([SongID]) FROM [' + cUS_Scores + '];';
- stBestSingers:
- Query := 'SELECT COUNT(DISTINCT [Player]) FROM [' + cUS_Scores + '];';
- stMostSungSong:
- Query := 'SELECT COUNT([ID]) FROM [' + cUS_Songs + '];';
- stMostPopBand:
- Query := 'SELECT COUNT(DISTINCT [Artist]) FROM [' + cUS_Songs + '];';
- end;
-
- Result := ScoreDB.GetTableValue(Query);
- except on E: Exception do
- Log.LogError(E.Message, 'TDataBaseSystem.GetTotalEntrys');
- end;
-
-end;
-
-(**
- * Gets reset date of statistic data
- *)
-function TDataBaseSystem.GetStatReset: TDateTime;
-var
- Query: string;
-begin
- Result := 0;
-
- if not Assigned(ScoreDB) then
- Exit;
-
- try
- Query := 'SELECT [ResetTime] FROM [' + cUS_Statistics_Info + '];';
- Result := UnixToDateTime(ScoreDB.GetTableValue(Query));
- except on E: Exception do
- Log.LogError(E.Message, 'TDataBaseSystem.GetStatReset');
- end;
-end;
-
-function TDataBaseSystem.GetVersion(): integer;
-begin
- Result := ScoreDB.GetTableValue('PRAGMA user_version');
-end;
-
-procedure TDataBaseSystem.SetVersion(Version: integer);
-begin
- ScoreDB.ExecSQL(Format('PRAGMA user_version = %d', [Version]));
-end;
-
-end.
diff --git a/src/base/UDraw.pas b/src/base/UDraw.pas
deleted file mode 100644
index 1783986f..00000000
--- a/src/base/UDraw.pas
+++ /dev/null
@@ -1,1408 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UDraw;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- UThemes,
- ModiSDK,
- UGraphicClasses;
-
-procedure SingDraw;
-procedure SingModiDraw (PlayerInfo: TPlayerInfo);
-procedure SingDrawBackground;
-procedure SingDrawOscilloscope(X, Y, W, H: real; NrSound: integer);
-procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer);
-procedure SingDrawLyricHelper(Left, LyricsMid: real);
-procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrLines: integer);
-procedure SingDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer);
-procedure SingDrawPlayerLine(X, Y, W: real; PlayerIndex: integer; Space: integer);
-procedure SingDrawPlayerBGLine(Left, Top, Right: real; NrLines, PlayerIndex: integer; Space: integer);
-
-// TimeBar
-procedure SingDrawTimeBar();
-
-//Draw Editor NoteLines
-procedure EditDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer);
-
-type
- TRecR = record
- Top: real;
- Left: real;
- Right: real;
- Bottom: real;
-
- Width: real;
- WMid: real;
- Height: real;
- HMid: real;
- Mid: real;
- end;
-
-var
- NotesW: real;
- NotesH: real;
- Starfr: integer;
- StarfrG: integer;
-
- //SingBar
- TickOld: cardinal;
- TickOld2: cardinal;
-
-implementation
-
-uses
- SysUtils,
- Math,
- gl,
- TextGL,
- UDLLManager,
- UDrawTexture,
- UGraphic,
- UIni,
- ULog,
- ULyrics,
- UNote,
- UMusic,
- URecord,
- UScreenSing,
- UScreenSingModi,
- UTexture;
-
-procedure SingDrawBackground;
-var
- Rec: TRecR;
- TexRec: TRecR;
-begin
- if (ScreenSing.Tex_Background.TexNum > 0) then
- begin
- if (Ini.MovieSize <= 1) then //HalfSize BG
- begin
- (* half screen + gradient *)
- Rec.Top := 110; // 80
- Rec.Bottom := Rec.Top + 20;
- Rec.Left := 0;
- Rec.Right := 800;
-
- TexRec.Top := (Rec.Top / 600) * ScreenSing.Tex_Background.TexH;
- TexRec.Bottom := (Rec.Bottom / 600) * ScreenSing.Tex_Background.TexH;
- TexRec.Left := 0;
- TexRec.Right := ScreenSing.Tex_Background.TexW;
-
- glEnable(GL_TEXTURE_2D);
- glBindTexture(GL_TEXTURE_2D, ScreenSing.Tex_Background.TexNum);
- glEnable(GL_BLEND);
- glBegin(GL_QUADS);
- (* gradient draw *)
- (* top *)
- glColor4f(1, 1, 1, 0);
- glTexCoord2f(TexRec.Right, TexRec.Top); glVertex2f(Rec.Right, Rec.Top);
- glTexCoord2f(TexRec.Left, TexRec.Top); glVertex2f(Rec.Left, Rec.Top);
- glColor4f(1, 1, 1, 1);
- glTexCoord2f(TexRec.Left, TexRec.Bottom); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(TexRec.Right, TexRec.Bottom); glVertex2f(Rec.Right, Rec.Bottom);
- (* mid *)
- Rec.Top := Rec.Bottom;
- Rec.Bottom := 490 - 20; // 490 - 20
- TexRec.Top := TexRec.Bottom;
- TexRec.Bottom := (Rec.Bottom / 600) * ScreenSing.Tex_Background.TexH;
- glTexCoord2f(TexRec.Left, TexRec.Top); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(TexRec.Left, TexRec.Bottom); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(TexRec.Right, TexRec.Bottom); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(TexRec.Right, TexRec.Top); glVertex2f(Rec.Right, Rec.Top);
- (* bottom *)
- Rec.Top := Rec.Bottom;
- Rec.Bottom := 490; // 490
- TexRec.Top := TexRec.Bottom;
- TexRec.Bottom := (Rec.Bottom / 600) * ScreenSing.Tex_Background.TexH;
- glTexCoord2f(TexRec.Right, TexRec.Top); glVertex2f(Rec.Right, Rec.Top);
- glTexCoord2f(TexRec.Left, TexRec.Top); glVertex2f(Rec.Left, Rec.Top);
- glColor4f(1, 1, 1, 0);
- glTexCoord2f(TexRec.Left, TexRec.Bottom); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(TexRec.Right, TexRec.Bottom); glVertex2f(Rec.Right, Rec.Bottom);
-
- glEnd;
- glDisable(GL_TEXTURE_2D);
- glDisable(GL_BLEND);
- end
- else //Full Size BG
- begin
- glEnable(GL_TEXTURE_2D);
- glBindTexture(GL_TEXTURE_2D, ScreenSing.Tex_Background.TexNum);
- //glEnable(GL_BLEND);
- glBegin(GL_QUADS);
-
- glTexCoord2f(0, 0); glVertex2f(0, 0);
- glTexCoord2f(0, ScreenSing.Tex_Background.TexH); glVertex2f(0, 600);
- glTexCoord2f( ScreenSing.Tex_Background.TexW, ScreenSing.Tex_Background.TexH); glVertex2f(800, 600);
- glTexCoord2f( ScreenSing.Tex_Background.TexW, 0); glVertex2f(800, 0);
-
- glEnd;
- glDisable(GL_TEXTURE_2D);
- //glDisable(GL_BLEND);
- end;
- end;
-end;
-
-procedure SingDrawOscilloscope(X, Y, W, H: real; NrSound: integer);
-var
- SampleIndex: integer;
- Sound: TCaptureBuffer;
- MaxX, MaxY: real;
-begin;
- Sound := AudioInputProcessor.Sound[NrSound];
-
- // Log.LogStatus('Oscilloscope', 'SingDraw');
- glColor3f(Skin_OscR, Skin_OscG, Skin_OscB);
-{
- if (ParamStr(1) = '-black') or (ParamStr(1) = '-fsblack') then
- glColor3f(1, 1, 1);
-}
- MaxX := W-1;
- MaxY := (H-1) / 2;
-
- Sound.LockAnalysisBuffer();
-
- glBegin(GL_LINE_STRIP);
- for SampleIndex := 0 to High(Sound.AnalysisBuffer) do
- begin
- glVertex2f(X + MaxX * SampleIndex/High(Sound.AnalysisBuffer),
- Y + MaxY * (1 - Sound.AnalysisBuffer[SampleIndex]/-Low(Smallint)));
- end;
- glEnd;
-
- Sound.UnlockAnalysisBuffer();
-end;
-
-procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer);
-var
- Count: integer;
-begin
- glEnable(GL_BLEND);
- glColor4f(Skin_P1_LinesR, Skin_P1_LinesG, Skin_P1_LinesB, 0.4);
- glBegin(GL_LINES);
- for Count := 0 to 9 do
- begin
- glVertex2f(Left, Top + Count * Space);
- glVertex2f(Right, Top + Count * Space);
- end;
- glEnd;
- glDisable(GL_BLEND);
-end;
-
-procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrLines: integer);
-var
- Count: integer;
- TempR: real;
-begin
- TempR := (Right-Left) / (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start);
- glEnable(GL_BLEND);
- glBegin(GL_LINES);
- for Count := Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start to Lines[NrLines].Line[Lines[NrLines].Current].End_ do
- begin
- if (Count mod Lines[NrLines].Resolution) = Lines[NrLines].NotesGAP then
- glColor4f(0, 0, 0, 1)
- else
- glColor4f(0, 0, 0, 0.3);
- glVertex2f(Left + TempR * (Count - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start), Top);
- glVertex2f(Left + TempR * (Count - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start), Top + 135);
- end;
- glEnd;
- glDisable(GL_BLEND);
-end;
-
-// draw blank Notebars
-procedure SingDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer);
-var
- Rec: TRecR;
- Count: integer;
- TempR: real;
-
- PlayerNumber: integer;
-
- GoldenStarPos: real;
-
- lTmpA, lTmpB : real;
-begin
-// We actually don't have a playernumber in this procedure, it should reside in NrLines - but it is always set to zero
-// So we exploit this behavior a bit - we give NrLines the playernumber, keep it in playernumber - and then we set NrLines to zero
-// This could also come quite in handy when we do the duet mode, cause just the notes for the player that has to sing should be drawn then
-// BUT this is not implemented yet, all notes are drawn! :D
-
- PlayerNumber := NrLines + 1; // Player 1 is 0
- NrLines := 0;
-
-// exploit done
-
- glColor3f(1, 1, 1);
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
-
- lTmpA := (Right-Left);
- lTmpB := (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start);
-
- if ( lTmpA > 0 ) and ( lTmpB > 0 ) then
- TempR := lTmpA / lTmpB
- else
- TempR := 0;
-
- with Lines[NrLines].Line[Lines[NrLines].Current] do
- begin
- for Count := 0 to HighNote do
- begin
- with Note[Count] do
- begin
- if NoteType <> ntFreestyle then
- begin
- if Ini.EffectSing = 0 then
- // If Golden note Effect of then Change not Color
- begin
- case NoteType of
- ntNormal: glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself
- ntGolden: glColor4f(1, 1, 0.3, 1); // no stars, paint yellow -> glColor4f(1, 1, 0.3, 0.85); - we could
- end; // case
- end //Else all Notes same Color
- else
- glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself
-
- // left part
- Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX;
- Rec.Right := Rec.Left + NotesW;
- Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH;
- Rec.Bottom := Rec.Top + 2 * NotesH;
- glBindTexture(GL_TEXTURE_2D, Tex_plain_Left[PlayerNumber].TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
-
- //We keep the postion of the top left corner b4 it's overwritten
- GoldenStarPos := Rec.Left;
- //done
-
- // middle part
- Rec.Left := Rec.Right;
- Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX;
-
- glBindTexture(GL_TEXTURE_2D, Tex_plain_Mid[PlayerNumber].TexNum);
- glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT );
- glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT );
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(round((Rec.Right-Rec.Left)/32), 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(round((Rec.Right-Rec.Left)/32), 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
-
- // right part
- Rec.Left := Rec.Right;
- Rec.Right := Rec.Right + NotesW;
-
- glBindTexture(GL_TEXTURE_2D, Tex_plain_Right[PlayerNumber].TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
-
- // Golden Star Patch
- if (NoteType = ntGolden) and (Ini.EffectSing=1) then
- begin
- GoldenRec.SaveGoldenStarsRec(GoldenStarPos, Rec.Top, Rec.Right, Rec.Bottom);
- end;
-
- end; // if not FreeStyle
- end; // with
- end; // for
- end; // with
-
- glDisable(GL_BLEND);
- glDisable(GL_TEXTURE_2D);
-end;
-
-// draw sung notes
-procedure SingDrawPlayerLine(X, Y, W: real; PlayerIndex: integer; Space: integer);
-var
- TempR: real;
- Rec: TRecR;
- N: integer;
-// R, G, B, A: real;
- NotesH2: real;
-begin
- //Log.LogStatus('Player notes', 'SingDraw');
-{
- if NrGracza = 0 then
- LoadColor(R, G, B, 'P1Light')
- else
- LoadColor(R, G, B, 'P2Light');
-}
- //R := 71/255;
- //G := 175/255;
- //B := 247/255;
-
- glColor3f(1, 1, 1);
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
-
- //if Player[NrGracza].LengthNote > 0 then
- begin
- TempR := W / (Lines[0].Line[Lines[0].Current].End_ - Lines[0].Line[Lines[0].Current].Note[0].Start);
- for N := 0 to Player[PlayerIndex].HighNote do
- begin
- with Player[PlayerIndex].Note[N] do
- begin
- // Left part of note
- Rec.Left := X + (Start-Lines[0].Line[Lines[0].Current].Note[0].Start) * TempR + 0.5 + 10*ScreenX;
- Rec.Right := Rec.Left + NotesW;
-
- // Draw it in half size, if not hit
- if Hit then
- begin
- NotesH2 := NotesH
- end
- else
- begin
- NotesH2 := int(NotesH * 0.65);
- end;
-
- Rec.Top := Y - (Tone-Lines[0].Line[Lines[0].Current].BaseNote)*Space/2 - NotesH2;
- Rec.Bottom := Rec.Top + 2 * NotesH2;
-
- // draw the left part
- glColor3f(1, 1, 1);
- glBindTexture(GL_TEXTURE_2D, Tex_Left[PlayerIndex+1].TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
-
- // Middle part of the note
- Rec.Left := Rec.Right;
- Rec.Right := X + (Start+Length-Lines[0].Line[Lines[0].Current].Note[0].Start) * TempR - NotesW - 0.5 + 10*ScreenX;
-
- // new
- if (Start+Length-1 = LyricsState.CurrentBeatD) then
- Rec.Right := Rec.Right - (1-Frac(LyricsState.MidBeatD)) * TempR;
- // the left note is more right than the right note itself, sounds weird - so we fix that xD
- if Rec.Right <= Rec.Left then
- Rec.Right := Rec.Left;
-
- // draw the middle part
- glBindTexture(GL_TEXTURE_2D, Tex_Mid[PlayerIndex+1].TexNum);
- glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT );
- glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT );
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(round((Rec.Right-Rec.Left)/32), 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(round((Rec.Right-Rec.Left)/32), 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
- glColor3f(1, 1, 1);
-
- // the right part of the note
- Rec.Left := Rec.Right;
- Rec.Right := Rec.Right + NotesW;
-
- glBindTexture(GL_TEXTURE_2D, Tex_Right[PlayerIndex+1].TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
-
- // Perfect note is stored
- if Perfect and (Ini.EffectSing=1) then
- begin
- //A := 1 - 2*(LyricsState.GetCurrentTime() - GetTimeFromBeat(Start+Length));
- if not (Start+Length-1 = LyricsState.CurrentBeatD) then
- begin
- //Star animation counter
- //inc(Starfr);
- //Starfr := Starfr mod 128;
- GoldenRec.SavePerfectNotePos(Rec.Left, Rec.Top);
- end;
- end;
- end; // with
- end; // for
-
- // actually we need a comparison here, to determine if the singing process
- // is ahead Rec.Right even if there is no singing
-
- if (Ini.EffectSing = 1) then
- GoldenRec.GoldenNoteTwinkle(Rec.Top,Rec.Bottom,Rec.Right, PlayerIndex);
- end; // if
-end;
-
-//draw Note glow
-procedure SingDrawPlayerBGLine(Left, Top, Right: real; NrLines, PlayerIndex: integer; Space: integer);
-var
- Rec: TRecR;
- Count: integer;
- TempR: real;
- X1, X2, X3, X4: real;
- W, H: real;
- lTmpA, lTmpB: real;
-begin
- if (Player[PlayerIndex].ScoreTotalInt >= 0) then
- begin
- glColor4f(1, 1, 1, sqrt((1+sin( AudioPlayback.Position * 3))/4)/ 2 + 0.5 );
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
-
- lTmpA := (Right-Left);
- lTmpB := (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start);
-
- if ( lTmpA > 0 ) and ( lTmpB > 0 ) then
- TempR := lTmpA / lTmpB
- else
- TempR := 0;
-
- with Lines[NrLines].Line[Lines[NrLines].Current] do
- begin
- for Count := 0 to HighNote do
- begin
- with Note[Count] do
- begin
- if NoteType <> ntFreestyle then
- begin
- // begin: 14, 20
- // easy: 6, 11
- W := NotesW * 2 + 2;
- H := NotesH * 1.5 + 3.5;
-
- X2 := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX + 4;
- X1 := X2-W;
-
- X3 := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - 0.5 + 10*ScreenX - 4;
- X4 := X3+W;
-
- // left
- Rec.Left := X1;
- Rec.Right := X2;
- Rec.Top := Top - (Tone-BaseNote)*Space/2 - H;
- Rec.Bottom := Rec.Top + 2 * H;
-
- glBindTexture(GL_TEXTURE_2D, Tex_BG_Left[PlayerIndex+1].TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
-
- // middle part
- Rec.Left := X2;
- Rec.Right := X3;
-
- glBindTexture(GL_TEXTURE_2D, Tex_BG_Mid[PlayerIndex+1].TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
-
- // right part
- Rec.Left := X3;
- Rec.Right := X4;
-
- glBindTexture(GL_TEXTURE_2D, Tex_BG_Right[PlayerIndex+1].TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
- end; // if not FreeStyle
- end; // with
- end; // for
- end; // with
-
- glDisable(GL_BLEND);
- glDisable(GL_TEXTURE_2D);
- end;
-end;
-
-(**
- * Draws the lyrics helper bar.
- * Left: position the bar starts at
- * LyricsMid: the middle of the lyrics relative to the position Left
- *)
-procedure SingDrawLyricHelper(Left, LyricsMid: real);
-var
- Bounds: TRecR; // bounds of the lyric help bar
- BarProgress: real; // progress of the lyrics helper
- BarMoveDelta: real; // current beat relative to the beat the bar starts to move at
- BarAlpha: real; // transparency
- CurLine: PLine; // current lyric line (beat specific)
- LineWidth: real; // lyric line width
- FirstNoteBeat: integer; // beat of the first note in the current line
- FirstNoteDelta: integer; // time in beats between the start of the current line and its first note
- MoveStartX: real; // x-pos. the bar starts to move from
- MoveDist: real; // number of pixels the bar will move
- LyricEngine: TLyricEngine;
-const
- BarWidth = 50; // width of the lyric helper bar
- BarHeight = 30; // height of the lyric helper bar
- BarMoveLimit = 40; // max. number of beats remaining before the bar starts to move
-begin
- // get current lyrics line and the time in beats of its first note
- CurLine := @Lines[0].Line[Lines[0].Current];
-
- // FIXME: accessing ScreenSing is not that generic
- LyricEngine := ScreenSing.Lyrics;
-
- // do not draw the lyrics helper if the current line does not contain any note
- if (Length(CurLine.Note) > 0) then
- begin
- // start beat of the first note of this line
- FirstNoteBeat := CurLine.Note[0].Start;
- // time in beats between the start of the current line and its first note
- FirstNoteDelta := FirstNoteBeat - CurLine.Start;
-
- // beats from current beat to the first note of the line
- BarMoveDelta := FirstNoteBeat - LyricsState.MidBeat;
-
- if (FirstNoteDelta > 8) and // if the wait-time is large enough
- (BarMoveDelta > 0) then // and the first note of the line is not reached
- begin
- // let the bar blink to the beat
- BarAlpha := 0.75 + cos(BarMoveDelta/2) * 0.25;
-
- // if the number of beats to the first note is too big,
- // the bar stays on the left side.
- if (BarMoveDelta > BarMoveLimit) then
- BarMoveDelta := BarMoveLimit;
-
- // limit number of beats the bar moves
- if (FirstNoteDelta > BarMoveLimit) then
- FirstNoteDelta := BarMoveLimit;
-
- // calc bar progress
- BarProgress := 1 - BarMoveDelta / FirstNoteDelta;
-
- // retrieve the width of the upper lyrics line on the display
- if (LyricEngine.GetUpperLine() <> nil) then
- LineWidth := LyricEngine.GetUpperLine().Width
- else
- LineWidth := 0;
-
- // distance the bar will move (LyricRec.Left to beginning of text)
- MoveDist := LyricsMid - LineWidth / 2 - BarWidth;
- // if the line is too long the helper might move from right to left
- // so we have to assure the start position is left of the text.
- if (MoveDist >= 0) then
- MoveStartX := Left
- else
- MoveStartX := Left + MoveDist;
-
- // determine lyric help bar position and size
- Bounds.Left := MoveStartX + BarProgress * MoveDist;
- Bounds.Right := Bounds.Left + BarWidth;
- Bounds.Top := Theme.LyricBar.IndicatorYOffset + Theme.LyricBar.UpperY ;
- Bounds.Bottom := Bounds.Top + BarHeight + 3;
-
- // draw lyric help bar
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glColor4f(1, 1, 1, BarAlpha);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glBindTexture(GL_TEXTURE_2D, Tex_Lyric_Help_Bar.TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Bounds.Left, Bounds.Top);
- glTexCoord2f(0, 1); glVertex2f(Bounds.Left, Bounds.Bottom);
- glTexCoord2f(1, 1); glVertex2f(Bounds.Right, Bounds.Bottom);
- glTexCoord2f(1, 0); glVertex2f(Bounds.Right, Bounds.Top);
- glEnd;
- glDisable(GL_BLEND);
- end;
- end;
-end;
-
-procedure SingDraw;
-var
- NR: TRecR; // lyrics area bounds (NR = NoteRec?)
- LyricEngine: TLyricEngine;
-begin
- // positions
- if Ini.SingWindow = 0 then
- NR.Left := 120
- else
- NR.Left := 20;
-
- NR.Right := 780;
-
- NR.Width := NR.Right - NR.Left;
- NR.WMid := NR.Width / 2;
- NR.Mid := NR.Left + NR.WMid;
-
- // FIXME: accessing ScreenSing is not that generic
- LyricEngine := ScreenSing.Lyrics;
-
- // draw time-bar
- SingDrawTimeBar();
-
- // draw note-lines
-
- if (PlayersPlay = 1) and (Ini.NoteLines = 1) then
- SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P2_NotesB - 105, NR.Right + 10*ScreenX, 15);
-
- if ((PlayersPlay = 2) or (PlayersPlay = 4)) and (Ini.NoteLines = 1) then
- begin
- SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P1_NotesB - 105, NR.Right + 10*ScreenX, 15);
- SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P2_NotesB - 105, NR.Right + 10*ScreenX, 15);
- end;
-
- if ((PlayersPlay = 3) or (PlayersPlay = 6)) and (Ini.NoteLines = 1) then
- begin
- SingDrawNoteLines(NR.Left + 10*ScreenX, 120, NR.Right + 10*ScreenX, 12);
- SingDrawNoteLines(NR.Left + 10*ScreenX, 245, NR.Right + 10*ScreenX, 12);
- SingDrawNoteLines(NR.Left + 10*ScreenX, 370, NR.Right + 10*ScreenX, 12);
- end;
-
- // draw Lyrics
- LyricEngine.Draw(LyricsState.MidBeat);
- SingDrawLyricHelper(NR.Left, NR.WMid);
-
- // oscilloscope
- if Ini.Oscilloscope = 1 then
- begin
- if PlayersPlay = 1 then
- SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0);
-
- if PlayersPlay = 2 then
- begin
- SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0);
- SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1);
- end;
-
- if PlayersPlay = 4 then
- begin
- if ScreenAct = 1 then
- begin
- SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0);
- SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1);
- end;
- if ScreenAct = 2 then
- begin
- SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 2);
- SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 3);
- end;
- end;
-
- if PlayersPlay = 3 then
- begin
- SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0);
- SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1);
- SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2);
- end;
-
- if PlayersPlay = 6 then
- begin
- if ScreenAct = 1 then
- begin
- SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0);
- SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1);
- SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2);
- end;
- if ScreenAct = 2 then
- begin
- SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 3);
- SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 4);
- SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 5);
- end;
- end;
-
- end;
-
- // Set the note heights according to the difficulty level
- case Ini.Difficulty of
- 0:
- begin
- NotesH := 11; // 9
- NotesW := 6; // 5
- end;
- 1:
- begin
- NotesH := 8; // 7
- NotesW := 4; // 4
- end;
- 2:
- begin
- NotesH := 5;
- NotesW := 3;
- end;
- end;
-
- // Draw the Notes
- if PlayersPlay = 1 then
- begin
- SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); // Background glow - colorized in playercolor
- SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); // Plain unsung notes - colorized in playercolor
- SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 0, 15); // imho the sung notes
- end;
-
- if PlayersPlay = 2 then
- begin
- SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 0, 15);
- SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 1, 15);
-
- SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15);
- SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15);
-
- SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 0, 15);
- SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 1, 15);
- end;
-
- if PlayersPlay = 3 then
- begin
- NotesW := NotesW * 0.8;
- NotesH := NotesH * 0.8;
-
- SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 0, 12);
- SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 1, 12);
- SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 2, 12);
-
- SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12);
- SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 1, 12);
- SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 2, 12);
-
- SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 0, 12);
- SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 1, 12);
- SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 2, 12);
- end;
-
- if PlayersPlay = 4 then
- begin
- if ScreenAct = 1 then
- begin
- SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 0, 15);
- SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 1, 15);
- end;
- if ScreenAct = 2 then
- begin
- SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 2, 15);
- SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 3, 15);
- end;
-
- if ScreenAct = 1 then
- begin
- SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15);
- SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15);
- end;
- if ScreenAct = 2 then
- begin
- SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 2, 15);
- SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 3, 15);
- end;
-
- if ScreenAct = 1 then
- begin
- SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 0, 15);
- SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 1, 15);
- end;
- if ScreenAct = 2 then
- begin
- SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 2, 15);
- SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 3, 15);
- end;
- end;
-
- if PlayersPlay = 6 then
- begin
- NotesW := NotesW * 0.8;
- NotesH := NotesH * 0.8;
-
- if ScreenAct = 1 then
- begin
- SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 0, 12);
- SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 1, 12);
- SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 2, 12);
- end;
- if ScreenAct = 2 then
- begin
- SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 3, 12);
- SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 4, 12);
- SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 5, 12);
- end;
-
- if ScreenAct = 1 then
- begin
- SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12);
- SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 1, 12);
- SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 2, 12);
- end;
- if ScreenAct = 2 then
- begin
- SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 3, 12);
- SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 4, 12);
- SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 5, 12);
- end;
-
- if ScreenAct = 1 then
- begin
- SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 0, 12);
- SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 1, 12);
- SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 2, 12);
- end;
- if ScreenAct = 2 then
- begin
- SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 3, 12);
- SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 4, 12);
- SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 5, 12);
- end;
- end;
- glDisable(GL_BLEND);
- glDisable(GL_TEXTURE_2D);
-end;
-
-// q'n'd for using the game mode dll's
-procedure SingModiDraw (PlayerInfo: TPlayerInfo);
-var
- NR: TRecR;
-begin
- // positions
- if Ini.SingWindow = 0 then
- begin
- NR.Left := 120;
- end
- else
- begin
- NR.Left := 20;
- end;
-
- NR.Right := 780;
- NR.Width := NR.Right - NR.Left;
- NR.WMid := NR.Width / 2;
- NR.Mid := NR.Left + NR.WMid;
-
- // time bar
- SingDrawTimeBar();
-
- if DLLMan.Selected.ShowNotes then
- begin
- if PlayersPlay = 1 then
- SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P2_NotesB - 105, NR.Right + 10*ScreenX, 15);
- if (PlayersPlay = 2) or (PlayersPlay = 4) then
- begin
- SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P1_NotesB - 105, NR.Right + 10*ScreenX, 15);
- SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P2_NotesB - 105, NR.Right + 10*ScreenX, 15);
- end;
-
- if (PlayersPlay = 3) or (PlayersPlay = 6) then
- begin
- SingDrawNoteLines(NR.Left + 10*ScreenX, 120, NR.Right + 10*ScreenX, 12);
- SingDrawNoteLines(NR.Left + 10*ScreenX, 245, NR.Right + 10*ScreenX, 12);
- SingDrawNoteLines(NR.Left + 10*ScreenX, 370, NR.Right + 10*ScreenX, 12);
- end;
- end;
-
- // Draw Lyrics
- ScreenSingModi.Lyrics.Draw(LyricsState.MidBeat);
- // TODO: Lyrics helper
-
- // oscilloscope | the thing that moves when you yell into your mic (imho)
- if (((Ini.Oscilloscope = 1) and (DLLMan.Selected.ShowRateBar_O)) and (not DLLMan.Selected.ShowRateBar)) then
- begin
- if PlayersPlay = 1 then
- if PlayerInfo.Playerinfo[0].Enabled then
- SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0);
-
- if PlayersPlay = 2 then
- begin
- if PlayerInfo.Playerinfo[0].Enabled then
- SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0);
- if PlayerInfo.Playerinfo[1].Enabled then
- SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1);
- end;
-
- if PlayersPlay = 4 then
- begin
- if ScreenAct = 1 then
- begin
- if PlayerInfo.Playerinfo[0].Enabled then
- SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0);
- if PlayerInfo.Playerinfo[1].Enabled then
- SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1);
- end;
- if ScreenAct = 2 then
- begin
- if PlayerInfo.Playerinfo[2].Enabled then
- SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 2);
- if PlayerInfo.Playerinfo[3].Enabled then
- SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 3);
- end;
- end;
-
- if PlayersPlay = 3 then
- begin
- if PlayerInfo.Playerinfo[0].Enabled then
- SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0);
- if PlayerInfo.Playerinfo[1].Enabled then
- SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1);
- if PlayerInfo.Playerinfo[2].Enabled then
- SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2);
- end;
-
- if PlayersPlay = 6 then
- begin
- if ScreenAct = 1 then
- begin
- if PlayerInfo.Playerinfo[0].Enabled then
- SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0);
- if PlayerInfo.Playerinfo[1].Enabled then
- SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1);
- if PlayerInfo.Playerinfo[2].Enabled then
- SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2);
- end;
- if ScreenAct = 2 then
- begin
- if PlayerInfo.Playerinfo[3].Enabled then
- SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 3);
- if PlayerInfo.Playerinfo[4].Enabled then
- SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 4);
- if PlayerInfo.Playerinfo[5].Enabled then
- SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 5);
- end;
- end;
-
- end;
-
-// resize the notes according to the difficulty level
- case Ini.Difficulty of
- 0:
- begin
- NotesH := 11; // 9
- NotesW := 6; // 5
- end;
- 1:
- begin
- NotesH := 8; // 7
- NotesW := 4; // 4
- end;
- 2:
- begin
- NotesH := 5;
- NotesW := 3;
- end;
- end;
-
- if (DLLMAn.Selected.ShowNotes and DLLMan.Selected.LoadSong) then
- begin
- if (PlayersPlay = 1) and PlayerInfo.Playerinfo[0].Enabled then
- begin
- SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15);
- SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15);
- SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 0, 15);
- end;
-
- if PlayersPlay = 2 then
- begin
- if PlayerInfo.Playerinfo[0].Enabled then
- begin
- SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 0, 15);
- SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15);
- SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 0, 15);
- end;
- if PlayerInfo.Playerinfo[1].Enabled then
- begin
- SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 1, 15);
- SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15);
- SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 1, 15);
- end;
-
- end;
-
- if PlayersPlay = 3 then
- begin
- NotesW := NotesW * 0.8;
- NotesH := NotesH * 0.8;
-
- if PlayerInfo.Playerinfo[0].Enabled then
- begin
- SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 0, 12);
- SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12);
- SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 0, 12);
- end;
-
- if PlayerInfo.Playerinfo[1].Enabled then
- begin
- SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 1, 12);
- SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 12);
- SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 1, 12);
- end;
-
- if PlayerInfo.Playerinfo[2].Enabled then
- begin
- SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 2, 12);
- SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 12);
- SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 2, 12);
- end;
- end;
-
- if PlayersPlay = 4 then
- begin
- if ScreenAct = 1 then
- begin
- SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 0, 15);
- SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 1, 15);
- end;
- if ScreenAct = 2 then
- begin
- SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 2, 15);
- SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 3, 15);
- end;
-
- SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15);
- SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15);
-
- if ScreenAct = 1 then
- begin
- SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 0, 15);
- SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 1, 15);
- end;
- if ScreenAct = 2 then
- begin
- SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 2, 15);
- SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 3, 15);
- end;
- end;
-
- if PlayersPlay = 6 then
- begin
- NotesW := NotesW * 0.8;
- NotesH := NotesH * 0.8;
-
- if ScreenAct = 1 then
- begin
- SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 0, 12);
- SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 1, 12);
- SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 2, 12);
- end;
- if ScreenAct = 2 then
- begin
- SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 3, 12);
- SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 4, 12);
- SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 5, 12);
- end;
-
- SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12);
- SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 12);
- SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 12);
-
- if ScreenAct = 1 then
- begin
- SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 0, 12);
- SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 1, 12);
- SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 2, 12);
- end;
- if ScreenAct = 2 then
- begin
- SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 3, 12);
- SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 4, 12);
- SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 5, 12);
- end;
- end;
- end;
-
- glDisable(GL_BLEND);
- glDisable(GL_TEXTURE_2D);
-end;
-
-{//SingBar Mod
-procedure SingDrawSingbar(X, Y, W, H: real; Percent: integer);
-var
- R: real;
- G: real;
- B: real;
- A: cardinal;
- I: integer;
-
-begin;
-
- //SingBar Background
- glColor4f(1, 1, 1, 0.8);
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glBindTexture(GL_TEXTURE_2D, Tex_SingBar_Back.TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(X, Y);
- glTexCoord2f(0, 1); glVertex2f(X, Y+H);
- glTexCoord2f(1, 1); glVertex2f(X+W, Y+H);
- glTexCoord2f(1, 0); glVertex2f(X+W, Y);
- glEnd;
-
- //SingBar coloured Bar
- case Percent of
- 0..22: begin
- R := 1;
- G := 0;
- B := 0;
- end;
- 23..42: begin
- R := 1;
- G := ((Percent-23)/100)*5;
- B := 0;
- end;
- 43..57: begin
- R := 1;
- G := 1;
- B := 0;
- end;
- 58..77: begin
- R := 1-(Percent - 58)/100*5;
- G := 1;
- B := 0;
- end;
- 78..99: begin
- R := 0;
- G := 1;
- B := 0;
- end;
- end; //case
-
- glColor4f(R, G, B, 1);
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glBindTexture(GL_TEXTURE_2D, Tex_SingBar_Bar.TexNum);
- //Size= Player[PlayerNum].ScorePercent of W
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(X, Y);
- glTexCoord2f(0, 1); glVertex2f(X, Y+H);
- glTexCoord2f(1, 1); glVertex2f(X+(W/100 * (Percent +1)), Y+H);
- glTexCoord2f(1, 0); glVertex2f(X+(W/100 * (Percent +1)), Y);
- glEnd;
-
- //SingBar Front
- glColor4f(1, 1, 1, 0.6);
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glBindTexture(GL_TEXTURE_2D, Tex_SingBar_Front.TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(X, Y);
- glTexCoord2f(0, 1); glVertex2f(X, Y+H);
- glTexCoord2f(1, 1); glVertex2f(X+W, Y+H);
- glTexCoord2f(1, 0); glVertex2f(X+W, Y);
- glEnd;
-end;
-//end Singbar Mod
-
-//PhrasenBonus - Line Bonus Pop Up
-procedure SingDrawLineBonus(const X, Y: Single; Color: TRGB; Alpha: Single; Text: string; Age: integer);
-var
- Length, X2: real; //Length of Text
- Size: integer; //Size of Popup
-begin
- if Alpha <> 0 then
- begin
-
-//Set Font Propertys
- SetFontStyle(2); //Font: Outlined1
- if Age < 5 then
- SetFontSize((Age + 1) * 3)
- else
- SetFontSize(18);
- SetFontItalic(False);
-
-//Check Font Size
- Length := glTextWidth (Text) + 3; //Little Space for a Better Look ^^
-
-//Text
- SetFontPos (X + 50 - (Length / 2), Y + 12); //Position
-
- if Age < 5 then
- Size := Age * 10
- else
- Size := 50;
-
-//Draw Background
-// glColor4f(Color.R, Color.G, Color.B, Alpha); //Set Color
- glColor4f(1, 1, 1, Alpha);
-
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
-// glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
-
-//New Method, Not Variable
- glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusBack[2].TexNum);
-
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(X + 50 - Size, Y + 25 - (Size/2));
- glTexCoord2f(0, 1); glVertex2f(X + 50 - Size, Y + 25 + (Size/2));
- glTexCoord2f(1, 1); glVertex2f(X + 50 + Size, Y + 25 + (Size/2));
- glTexCoord2f(1, 0); glVertex2f(X + 50 + Size, Y + 25 - (Size/2));
- glEnd;
-
- glColor4f(1, 1, 1, Alpha); //Set Color
-//Draw Text
- glPrint (Text);
- end;
-end;
-//PhrasenBonus - Line Bonus Mod}
-
-// Draw Note Bars for Editor
-// There are 11 reasons for a new procedure: (nice binary :D )
-// 1. It does not look good when you draw the golden note star effect in the editor
-// 2. You can see the freestyle notes in the editor semitransparent
-// 3. It is easier and faster then changing the old procedure
-procedure EditDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer);
-var
- Rec: TRecR;
- Count: integer;
- TempR: real;
-begin
- glColor3f(1, 1, 1);
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- TempR := (Right-Left) / (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start);
- with Lines[NrLines].Line[Lines[NrLines].Current] do
- begin
- for Count := 0 to HighNote do
- begin
- with Note[Count] do
- begin
-
- // Golden Note Patch
- case NoteType of
- ntFreestyle: glColor4f(1, 1, 1, 0.35);
- ntNormal: glColor4f(1, 1, 1, 0.85);
- ntGolden: Glcolor4f(1, 1, 0.3, 0.85);
- end; // case
-
- // left part
- Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX;
- Rec.Right := Rec.Left + NotesW;
- Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH;
- Rec.Bottom := Rec.Top + 2 * NotesH;
- glBindTexture(GL_TEXTURE_2D, Tex_Left[Color].TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
-
- // middle part
- Rec.Left := Rec.Right;
- Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX;
-
- glBindTexture(GL_TEXTURE_2D, Tex_Mid[Color].TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
-
- // right part
- Rec.Left := Rec.Right;
- Rec.Right := Rec.Right + NotesW;
-
- glBindTexture(GL_TEXTURE_2D, Tex_Right[Color].TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
-
- end; // with
- end; // for
- end; // with
-
- glDisable(GL_BLEND);
- glDisable(GL_TEXTURE_2D);
-end;
-
-procedure SingDrawTimeBar();
-var
- x, y: real;
- width, height: real;
- LyricsProgress: real;
- CurLyricsTime: real;
-begin
- x := Theme.Sing.StaticTimeProgress.x;
- y := Theme.Sing.StaticTimeProgress.y;
-
- width := Theme.Sing.StaticTimeProgress.w;
- height := Theme.Sing.StaticTimeProgress.h;
-
- glColor4f(Theme.Sing.StaticTimeProgress.ColR,
- Theme.Sing.StaticTimeProgress.ColG,
- Theme.Sing.StaticTimeProgress.ColB, 1); //Set Color
-
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
-
- glBindTexture(GL_TEXTURE_2D, Tex_TimeProgress.TexNum);
-
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0);
- glVertex2f(x, y);
-
- CurLyricsTime := LyricsState.GetCurrentTime();
- if (CurLyricsTime > 0) and
- (LyricsState.TotalTime > 0) then
- begin
- LyricsProgress := CurLyricsTime / LyricsState.TotalTime;
- glTexCoord2f((width * LyricsProgress) / 8, 0);
- glVertex2f(x + width * LyricsProgress, y);
-
- glTexCoord2f((width * LyricsProgress) / 8, 1);
- glVertex2f(x + width * LyricsProgress, y + height);
- end;
-
- glTexCoord2f(0, 1);
- glVertex2f(x, y + height);
- glEnd;
-
- glDisable(GL_TEXTURE_2D);
- glDisable(GL_BLEND);
- glcolor4f(1, 1, 1, 1);
-end;
-
-end.
-
diff --git a/src/base/UEditorLyrics.pas b/src/base/UEditorLyrics.pas
deleted file mode 100644
index 0eacd1f9..00000000
--- a/src/base/UEditorLyrics.pas
+++ /dev/null
@@ -1,259 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UEditorLyrics;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- SysUtils,
- gl,
- UMusic,
- UTexture;
-
-type
- TAlignmentType = (atLeft, atCenter, atRight);
-
- TWord = record
- X: real;
- Y: real;
- Size: real;
- Width: real;
- Text: string;
- ColR: real;
- ColG: real;
- ColB: real;
- FontStyle: integer;
- Italic: boolean;
- Selected: boolean;
- end;
-
- TEditorLyrics = class
- private
- AlignI: TAlignmentType;
- XR: real;
- YR: real;
- SizeR: real;
- SelectedI: integer;
- FontStyleI: integer; // font number
- Word: array of TWord;
-
- procedure SetX(Value: real);
- procedure SetY(Value: real);
- function GetClientX: real;
- procedure SetAlign(Value: TAlignmentType);
- function GetSize: real;
- procedure SetSize(Value: real);
- procedure SetSelected(Value: integer);
- procedure SetFontStyle(Value: integer);
- procedure AddWord(Text: UTF8String);
- procedure Refresh;
- public
- ColR: real;
- ColG: real;
- ColB: real;
- ColSR: real;
- ColSG: real;
- ColSB: real;
- Italic: boolean;
-
- constructor Create;
- destructor Destroy; override;
-
- procedure AddLine(NrLine: integer);
-
- procedure Clear;
- procedure Draw;
- published
- property X: real write SetX;
- property Y: real write SetY;
- property ClientX: real read GetClientX;
- property Align: TAlignmentType write SetAlign;
- property Size: real read GetSize write SetSize;
- property Selected: integer read SelectedI write SetSelected;
- property FontStyle: integer write SetFontStyle;
- end;
-
-implementation
-
-uses
- TextGL,
- UGraphic,
- UDrawTexture,
- Math,
- USkins;
-
-constructor TEditorLyrics.Create;
-begin
- inherited;
-end;
-
-destructor TEditorLyrics.Destroy;
-begin
- SetLength(Word, 0);
- inherited;
-end;
-
-procedure TEditorLyrics.SetX(Value: real);
-begin
- XR := Value;
-end;
-
-procedure TEditorLyrics.SetY(Value: real);
-begin
- YR := Value;
-end;
-
-function TEditorLyrics.GetClientX: real;
-begin
- Result := Word[0].X;
-end;
-
-procedure TEditorLyrics.SetAlign(Value: TAlignmentType);
-begin
- AlignI := Value;
-end;
-
-function TEditorLyrics.GetSize: real;
-begin
- Result := SizeR;
-end;
-
-procedure TEditorLyrics.SetSize(Value: real);
-begin
- SizeR := Value;
-end;
-
-procedure TEditorLyrics.SetSelected(Value: integer);
-begin
- if (-1 < SelectedI) and (SelectedI <= High(Word)) then
- begin
- Word[SelectedI].Selected := false;
- Word[SelectedI].ColR := ColR;
- Word[SelectedI].ColG := ColG;
- Word[SelectedI].ColB := ColB;
- end;
-
- SelectedI := Value;
- if (-1 < Value) and (Value <= High(Word)) then
- begin
- Word[Value].Selected := true;
- Word[Value].ColR := ColSR;
- Word[Value].ColG := ColSG;
- Word[Value].ColB := ColSB;
- end;
-
- Refresh;
-end;
-
-procedure TEditorLyrics.SetFontStyle(Value: integer);
-begin
- FontStyleI := Value;
-end;
-
-procedure TEditorLyrics.AddWord(Text: UTF8String);
-var
- WordNum: integer;
-begin
- WordNum := Length(Word);
- SetLength(Word, WordNum + 1);
- if WordNum = 0 then
- Word[WordNum].X := XR
- else
- Word[WordNum].X := Word[WordNum - 1].X + Word[WordNum - 1].Width;
-
- Word[WordNum].Y := YR;
- Word[WordNum].Size := SizeR;
- Word[WordNum].FontStyle := FontStyleI;
- SetFontStyle(FontStyleI);
- SetFontSize(SizeR);
- Word[WordNum].Width := glTextWidth(Text);
- Word[WordNum].Text := Text;
- Word[WordNum].ColR := ColR;
- Word[WordNum].ColG := ColG;
- Word[WordNum].ColB := ColB;
- Word[WordNum].Italic := Italic;
-
- Refresh;
-end;
-
-procedure TEditorLyrics.AddLine(NrLine: integer);
-var
- NoteIndex: integer;
-begin
- Clear;
- for NoteIndex := 0 to Lines[0].Line[NrLine].HighNote do
- begin
- Italic := Lines[0].Line[NrLine].Note[NoteIndex].NoteType = ntFreestyle;
- AddWord(Lines[0].Line[NrLine].Note[NoteIndex].Text);
- end;
- Selected := -1;
-end;
-
-procedure TEditorLyrics.Clear;
-begin
- SetLength(Word, 0);
- SelectedI := -1;
-end;
-
-procedure TEditorLyrics.Refresh;
-var
- WordIndex: integer;
- TotalWidth: real;
-begin
- if AlignI = atCenter then
- begin
- TotalWidth := 0;
- for WordIndex := 0 to High(Word) do
- TotalWidth := TotalWidth + Word[WordIndex].Width;
-
- Word[0].X := XR - TotalWidth / 2;
- for WordIndex := 1 to High(Word) do
- Word[WordIndex].X := Word[WordIndex - 1].X + Word[WordIndex - 1].Width;
- end;
-end;
-
-procedure TEditorLyrics.Draw;
-var
- WordIndex: integer;
-begin
- for WordIndex := 0 to High(Word) do
- begin
- SetFontStyle(Word[WordIndex].FontStyle);
- SetFontPos(Word[WordIndex].X + 10*ScreenX, Word[WordIndex].Y);
- SetFontSize(Word[WordIndex].Size);
- SetFontItalic(Word[WordIndex].Italic);
- glColor3f(Word[WordIndex].ColR, Word[WordIndex].ColG, Word[WordIndex].ColB);
- glPrint(Word[WordIndex].Text);
- end;
-end;
-
-end.
diff --git a/src/base/UFiles.pas b/src/base/UFiles.pas
deleted file mode 100644
index 5a258e3e..00000000
--- a/src/base/UFiles.pas
+++ /dev/null
@@ -1,212 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UFiles;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-{$I switches.inc}
-
-uses
- SysUtils,
- Classes,
- ULog,
- UMusic,
- USongs,
- USong,
- UPath;
-
-procedure ResetSingTemp;
-
-type
- TSaveSongResult = (ssrOK, ssrFileError, ssrEncodingError);
-
-{**
- * Throws a TEncodingException if the song's fields cannot be encoded in the
- * requested encoding.
- *}
-function SaveSong(const Song: TSong; const Lines: TLines; const Name: IPath; Relative: boolean): TSaveSongResult;
-
-implementation
-
-uses
- TextGL,
- UIni,
- UNote,
- UPlatform,
- UUnicodeUtils,
- UTextEncoding;
-
-//--------------------
-// Resets the temporary Sentence Arrays for each Player and some other Variables
-//--------------------
-procedure ResetSingTemp;
-var
- Count: integer;
-begin
- SetLength(Lines, Length(Player));
- for Count := 0 to High(Player) do begin
- SetLength(Lines[Count].Line, 1);
- SetLength(Lines[Count].Line[0].Note, 0);
- Lines[Count].Line[0].Lyric := '';
- Player[Count].Score := 0;
- Player[Count].LengthNote := 0;
- Player[Count].HighNote := -1;
- end;
-end;
-
-//--------------------
-// Saves a Song
-//--------------------
-function SaveSong(const Song: TSong; const Lines: TLines; const Name: IPath; Relative: boolean): TSaveSongResult;
-var
- C: integer;
- N: integer;
- S: AnsiString;
- B: integer;
- RelativeSubTime: integer;
- NoteState: AnsiString;
- SongFile: TTextFileStream;
-
- function EncodeToken(const Str: UTF8String): RawByteString;
- var
- Success: boolean;
- begin
- Success := EncodeStringUTF8(Str, Result, Song.Encoding);
- if (not Success) then
- SaveSong := ssrEncodingError;
- end;
-
- procedure WriteCustomTags;
- var
- I: integer;
- Line: RawByteString;
- begin
- for I := 0 to High(Song.CustomTags) do
- begin
- Line := EncodeToken(Song.CustomTags[I].Content);
- if (Length(Song.CustomTags[I].Tag) > 0) then
- Line := EncodeToken(Song.CustomTags[I].Tag) + ':' + Line;
-
- SongFile.WriteLine('#' + Line);
- end;
-
- end;
-
-begin
- // Relative := true; // override (idea - use shift+S to save with relative)
- Result := ssrOK;
-
- try
- SongFile := TMemTextFileStream.Create(Name, fmCreate);
- try
- // to-do: should we really write the BOM?
- // it causes problems w/ older versions
- // e.g. usdx 1.0.1a or ultrastar < 0.7.0
- if (Song.Encoding = encUTF8) then
- SongFile.WriteString(UTF8_BOM);
-
- SongFile.WriteLine('#ENCODING:' + EncodingName(Song.Encoding));
- SongFile.WriteLine('#TITLE:' + EncodeToken(Song.Title));
- SongFile.WriteLine('#ARTIST:' + EncodeToken(Song.Artist));
-
- if Song.Creator <> '' then SongFile.WriteLine('#CREATOR:' + EncodeToken(Song.Creator));
- if Song.Edition <> 'Unknown' then SongFile.WriteLine('#EDITION:' + EncodeToken(Song.Edition));
- if Song.Genre <> 'Unknown' then SongFile.WriteLine('#GENRE:' + EncodeToken(Song.Genre));
- if Song.Language <> 'Unknown' then SongFile.WriteLine('#LANGUAGE:' + EncodeToken(Song.Language));
- if Song.Year <> 0 then SongFile.WriteLine('#YEAR:' + IntToStr(Song.Year));
-
- SongFile.WriteLine('#MP3:' + EncodeToken(Song.Mp3.ToUTF8));
- if Song.Cover.IsSet then SongFile.WriteLine('#COVER:' + EncodeToken(Song.Cover.ToUTF8));
- if Song.Background.IsSet then SongFile.WriteLine('#BACKGROUND:' + EncodeToken(Song.Background.ToUTF8));
- if Song.Video.IsSet then SongFile.WriteLine('#VIDEO:' + EncodeToken(Song.Video.ToUTF8));
-
- if Song.VideoGAP <> 0 then SongFile.WriteLine('#VIDEOGAP:' + FloatToStr(Song.VideoGAP));
- if Song.Resolution <> 4 then SongFile.WriteLine('#RESOLUTION:' + IntToStr(Song.Resolution));
- if Song.NotesGAP <> 0 then SongFile.WriteLine('#NOTESGAP:' + IntToStr(Song.NotesGAP));
- if Song.Start <> 0 then SongFile.WriteLine('#START:' + FloatToStr(Song.Start));
- if Song.Finish <> 0 then SongFile.WriteLine('#END:' + IntToStr(Song.Finish));
- if Relative then SongFile.WriteLine('#RELATIVE:yes');
-
- SongFile.WriteLine('#BPM:' + FloatToStr(Song.BPM[0].BPM / 4));
- SongFile.WriteLine('#GAP:' + FloatToStr(Song.GAP));
-
- // write custom header tags
- WriteCustomTags;
-
- RelativeSubTime := 0;
- for B := 1 to High(Song.BPM) do
- SongFile.WriteLine('B ' + FloatToStr(Song.BPM[B].StartBeat) + ' '
- + FloatToStr(Song.BPM[B].BPM/4));
-
- for C := 0 to Lines.High do
- begin
- for N := 0 to Lines.Line[C].HighNote do
- begin
- with Lines.Line[C].Note[N] do
- begin
- //Golden + Freestyle Note Patch
- case Lines.Line[C].Note[N].NoteType of
- ntFreestyle: NoteState := 'F ';
- ntNormal: NoteState := ': ';
- ntGolden: NoteState := '* ';
- end; // case
- S := NoteState + IntToStr(Start-RelativeSubTime) + ' '
- + IntToStr(Length) + ' '
- + IntToStr(Tone) + ' '
- + EncodeToken(Text);
-
- SongFile.WriteLine(S);
- end; // with
- end; // N
-
- if C < Lines.High then // don't write end of last sentence
- begin
- if not Relative then
- S := '- ' + IntToStr(Lines.Line[C+1].Start)
- else
- begin
- S := '- ' + IntToStr(Lines.Line[C+1].Start - RelativeSubTime) +
- ' ' + IntToStr(Lines.Line[C+1].Start - RelativeSubTime);
- RelativeSubTime := Lines.Line[C+1].Start;
- end;
- SongFile.WriteLine(S);
- end;
- end; // C
-
- SongFile.WriteLine('E');
- finally
- SongFile.Free;
- end;
- except
- Result := ssrFileError;
- end;
-end;
-
-end.
-
diff --git a/src/base/UFilesystem.pas b/src/base/UFilesystem.pas
deleted file mode 100644
index d4972df5..00000000
--- a/src/base/UFilesystem.pas
+++ /dev/null
@@ -1,692 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UFilesystem;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- SysUtils,
- Classes,
- {$IFDEF MSWINDOWS}
- Windows,
- TntSysUtils,
- {$ENDIF}
- UPath;
-
-type
- {$IFDEF MSWINDOWS}
- TSytemSearchRec = TSearchRecW;
- {$ELSE}
- TSytemSearchRec = TSearchRec;
- {$ENDIF}
-
- TFileInfo = record
- Time: integer; // timestamp
- Size: int64; // file size (byte)
- Attr: integer; // file attributes
- Name: IPath; // basename with extension
- end;
-
- {**
- * Iterates through the search results retrieved by FileFind().
- * Example usage:
- * while(Iter.HasNext()) do
- * SearchRec := Iter.Next();
- *}
- IFileIterator = interface
- function HasNext(): boolean;
- function Next(): TFileInfo;
- end;
-
- {**
- * Wrapper for SysUtils file functions.
- * For documentation and examples, check the SysUtils equivalent.
- *}
- IFileSystem = interface
- function ExpandFileName(const FileName: IPath): IPath;
- function FileCreate(const FileName: IPath): THandle;
- function DirectoryCreate(const Dir: IPath): boolean;
- function FileOpen(const FileName: IPath; Mode: longword): THandle;
- function FileAge(const FileName: IPath): integer; overload;
- function FileAge(const FileName: IPath; out FileDateTime: TDateTime): boolean; overload;
-
- function DirectoryExists(const Name: IPath): boolean;
-
- {**
- * On Windows: returns true only for files (not directories)
- * On Apple/Unix: returns true for all kind of files (even directories)
- * @seealso SysUtils.FileExists()
- *}
- function FileExists(const Name: IPath): boolean;
-
- function FileGetAttr(const FileName: IPath): Cardinal;
- function FileSetAttr(const FileName: IPath; Attr: integer): boolean;
- function FileIsReadOnly(const FileName: IPath): boolean;
- function FileSetReadOnly(const FileName: IPath; ReadOnly: boolean): boolean;
- function FileIsAbsolute(const FileName: IPath): boolean;
- function ForceDirectories(const Dir: IPath): boolean;
- function RenameFile(const OldName, NewName: IPath): boolean;
- function DeleteFile(const FileName: IPath): boolean;
- function RemoveDir(const Dir: IPath): boolean;
-
- {**
- * Copies file Source to Target. If FailIfExists is true, the file is not
- * copied if it already exists.
- * Returns true if the file was successfully copied.
- *}
- function CopyFile(const Source, Target: IPath; FailIfExists: boolean): boolean;
-
- function ExtractFileDrive(const FileName: IPath): IPath;
- function ExtractFilePath(const FileName: IPath): IPath;
- function ExtractFileDir(const FileName: IPath): IPath;
- function ExtractFileName(const FileName: IPath): IPath;
- function ExtractFileExt(const FileName: IPath): IPath;
- function ExtractRelativePath(const BaseName: IPath; const FileName: IPath): IPath;
-
- function ChangeFileExt(const FileName: IPath; const Extension: IPath): IPath;
-
- function IncludeTrailingPathDelimiter(const FileName: IPath): IPath;
- function ExcludeTrailingPathDelimiter(const FileName: IPath): IPath;
-
- {**
- * Searches for a file with filename Name in the directories given in DirList.
- *}
- function FileSearch(const Name: IPath; DirList: array of IPath): IPath;
-
- {**
- * More convenient version of FindFirst/Next/Close with iterator support.
- *}
- function FileFind(const FilePattern: IPath; Attr: integer): IFileIterator;
-
- {**
- * Old style search functions. Use FileFind() instead.
- *}
- function FindFirst(const FilePattern: IPath; Attr: integer; var F: TSytemSearchRec): integer;
- function FindNext(var F: TSytemSearchRec): integer;
- procedure FindClose(var F: TSytemSearchRec);
-
- function GetCurrentDir: IPath;
- function SetCurrentDir(const Dir: IPath): boolean;
-
- {**
- * Returns true if the filesystem is case-sensitive.
- *}
- function IsCaseSensitive(): boolean;
- end;
-
- function FileSystem(): IFileSystem;
-
-implementation
-
-type
- TFileSystemImpl = class(TInterfacedObject, IFileSystem)
- public
- function ExpandFileName(const FileName: IPath): IPath;
- function FileCreate(const FileName: IPath): THandle;
- function DirectoryCreate(const Dir: IPath): boolean;
- function FileOpen(const FileName: IPath; Mode: longword): THandle;
- function FileAge(const FileName: IPath): integer; overload;
- function FileAge(const FileName: IPath; out FileDateTime: TDateTime): boolean; overload;
- function DirectoryExists(const Name: IPath): boolean;
- function FileExists(const Name: IPath): boolean;
- function FileGetAttr(const FileName: IPath): Cardinal;
- function FileSetAttr(const FileName: IPath; Attr: integer): boolean;
- function FileIsReadOnly(const FileName: IPath): boolean;
- function FileSetReadOnly(const FileName: IPath; ReadOnly: boolean): boolean;
- function FileIsAbsolute(const FileName: IPath): boolean;
- function ForceDirectories(const Dir: IPath): boolean;
- function RenameFile(const OldName, NewName: IPath): boolean;
- function DeleteFile(const FileName: IPath): boolean;
- function RemoveDir(const Dir: IPath): boolean;
- function CopyFile(const Source, Target: IPath; FailIfExists: boolean): boolean;
-
- function ExtractFileDrive(const FileName: IPath): IPath;
- function ExtractFilePath(const FileName: IPath): IPath;
- function ExtractFileDir(const FileName: IPath): IPath;
- function ExtractFileName(const FileName: IPath): IPath;
- function ExtractFileExt(const FileName: IPath): IPath;
- function ExtractRelativePath(const BaseName: IPath; const FileName: IPath): IPath;
- function ChangeFileExt(const FileName: IPath; const Extension: IPath): IPath;
- function IncludeTrailingPathDelimiter(const FileName: IPath): IPath;
- function ExcludeTrailingPathDelimiter(const FileName: IPath): IPath;
-
- function FileSearch(const Name: IPath; DirList: array of IPath): IPath;
- function FileFind(const FilePattern: IPath; Attr: integer): IFileIterator;
-
- function FindFirst(const FilePattern: IPath; Attr: integer; var F: TSytemSearchRec): integer;
- function FindNext(var F: TSytemSearchRec): integer;
- procedure FindClose(var F: TSytemSearchRec);
-
- function GetCurrentDir: IPath;
- function SetCurrentDir(const Dir: IPath): boolean;
-
- function IsCaseSensitive(): boolean;
- end;
-
- TFileIterator = class(TInterfacedObject, IFileIterator)
- private
- fHasNext: boolean;
- fSearchRec: TSytemSearchRec;
- public
- constructor Create(const FilePattern: IPath; Attr: integer);
- destructor Destroy(); override;
-
- function HasNext(): boolean;
- function Next(): TFileInfo;
- end;
-
-
-var
- FileSystem_Singleton: IFileSystem;
-
-function FileSystem(): IFileSystem;
-begin
- Result := FileSystem_Singleton;
-end;
-
-function TFileSystemImpl.FileFind(const FilePattern: IPath; Attr: integer): IFileIterator;
-begin
- Result := TFileIterator.Create(FilePattern, Attr);
-end;
-
-function TFileSystemImpl.IsCaseSensitive(): boolean;
-begin
- // Windows and Mac OS X do not have case sensitive file systems
- {$IF Defined(MSWINDOWS) or Defined(DARWIN)}
- Result := false;
- {$ELSE}
- Result := true;
- {$IFEND}
-end;
-
-function TFileSystemImpl.FileIsAbsolute(const FileName: IPath): boolean;
-var
- NameStr: UTF8String;
-begin
- Result := true;
- NameStr := FileName.ToUTF8();
-
- {$IFDEF MSWINDOWS}
- // check if drive is given 'C:...'
- if (FileName.GetDrive().ToUTF8 <> '') then
- Exit;
- // check if path starts with '\\'
- if (Length(NameStr) >= 2) and
- (NameStr[1] = PathDelim) and (NameStr[2] = PathDelim) then
- Exit;
- {$ELSE} // Unix based systems
- // check if root dir given '/...'
- if (Length(NameStr) >= 1) and (NameStr[1] = PathDelim) then
- Exit;
- {$ENDIF}
-
- Result := false;
-end;
-
-{$IFDEF MSWINDOWS}
-
-function TFileSystemImpl.ExpandFileName(const FileName: IPath): IPath;
-begin
- Result := Path(WideExpandFileName(FileName.ToWide()));
-end;
-
-function TFileSystemImpl.FileCreate(const FileName: IPath): THandle;
-begin
- Result := WideFileCreate(FileName.ToWide());
-end;
-
-function TFileSystemImpl.DirectoryCreate(const Dir: IPath): boolean;
-begin
- Result := WideCreateDir(Dir.ToWide());
-end;
-
-function TFileSystemImpl.FileOpen(const FileName: IPath; Mode: longword): THandle;
-begin
- Result := WideFileOpen(FileName.ToWide(), Mode);
-end;
-
-function TFileSystemImpl.FileAge(const FileName: IPath): integer;
-begin
- Result := WideFileAge(FileName.ToWide());
-end;
-
-function TFileSystemImpl.FileAge(const FileName: IPath; out FileDateTime: TDateTime): boolean;
-begin
- Result := WideFileAge(FileName.ToWide(), FileDateTime);
-end;
-
-function TFileSystemImpl.DirectoryExists(const Name: IPath): boolean;
-begin
- Result := WideDirectoryExists(Name.ToWide());
-end;
-
-function TFileSystemImpl.FileExists(const Name: IPath): boolean;
-begin
- Result := WideFileExists(Name.ToWide());
-end;
-
-function TFileSystemImpl.FileGetAttr(const FileName: IPath): Cardinal;
-begin
- Result := WideFileGetAttr(FileName.ToWide());
-end;
-
-function TFileSystemImpl.FileSetAttr(const FileName: IPath; Attr: integer): boolean;
-begin
- Result := WideFileSetAttr(FileName.ToWide(), Attr);
-end;
-
-function TFileSystemImpl.FileIsReadOnly(const FileName: IPath): boolean;
-begin
- Result := WideFileIsReadOnly(FileName.ToWide());
-end;
-
-function TFileSystemImpl.FileSetReadOnly(const FileName: IPath; ReadOnly: boolean): boolean;
-begin
- Result := WideFileSetReadOnly(FileName.ToWide(), ReadOnly);
-end;
-
-function TFileSystemImpl.ForceDirectories(const Dir: IPath): boolean;
-begin
- Result := WideForceDirectories(Dir.ToWide());
-end;
-
-function TFileSystemImpl.FileSearch(const Name: IPath; DirList: array of IPath): IPath;
-var
- I: integer;
- DirListStr: WideString;
-begin
- DirListStr := '';
- for I := 0 to High(DirList) do
- begin
- if (I > 0) then
- DirListStr := DirListStr + PathSep;
- DirListStr := DirListStr + DirList[I].ToWide();
- end;
- Result := Path(WideFileSearch(Name.ToWide(), DirListStr));
-end;
-
-function TFileSystemImpl.RenameFile(const OldName, NewName: IPath): boolean;
-begin
- Result := WideRenameFile(OldName.ToWide(), NewName.ToWide());
-end;
-
-function TFileSystemImpl.DeleteFile(const FileName: IPath): boolean;
-begin
- Result := WideDeleteFile(FileName.ToWide());
-end;
-
-function TFileSystemImpl.RemoveDir(const Dir: IPath): boolean;
-begin
- Result := WideRemoveDir(Dir.ToWide());
-end;
-
-function TFileSystemImpl.CopyFile(const Source, Target: IPath; FailIfExists: boolean): boolean;
-begin
- Result := WideCopyFile(Source.ToWide(), Target.ToWide(), FailIfExists);
-end;
-
-function TFileSystemImpl.ExtractFileDrive(const FileName: IPath): IPath;
-begin
- Result := Path(WideExtractFileDrive(FileName.ToWide()));
-end;
-
-function TFileSystemImpl.ExtractFilePath(const FileName: IPath): IPath;
-begin
- Result := Path(WideExtractFilePath(FileName.ToWide()));
-end;
-
-function TFileSystemImpl.ExtractFileDir(const FileName: IPath): IPath;
-begin
- Result := Path(WideExtractFileDir(FileName.ToWide()));
-end;
-
-function TFileSystemImpl.ExtractFileName(const FileName: IPath): IPath;
-begin
- Result := Path(WideExtractFileName(FileName.ToWide()));
-end;
-
-function TFileSystemImpl.ExtractFileExt(const FileName: IPath): IPath;
-begin
- Result := Path(WideExtractFileExt(FileName.ToWide()));
-end;
-
-function TFileSystemImpl.ExtractRelativePath(const BaseName: IPath; const FileName: IPath): IPath;
-begin
- Result := Path(WideExtractRelativePath(BaseName.ToWide(), FileName.ToWide()));
-end;
-
-function TFileSystemImpl.ChangeFileExt(const FileName: IPath; const Extension: IPath): IPath;
-begin
- Result := Path(WideChangeFileExt(FileName.ToWide(), Extension.ToWide()));
-end;
-
-function TFileSystemImpl.IncludeTrailingPathDelimiter(const FileName: IPath): IPath;
-begin
- Result := Path(WideIncludeTrailingPathDelimiter(FileName.ToWide()));
-end;
-
-function TFileSystemImpl.ExcludeTrailingPathDelimiter(const FileName: IPath): IPath;
-begin
- Result := Path(WideExcludeTrailingPathDelimiter(FileName.ToWide()));
-end;
-
-function TFileSystemImpl.FindFirst(const FilePattern: IPath; Attr: integer; var F: TSytemSearchRec): integer;
-begin
- Result := WideFindFirst(FilePattern.ToWide(), Attr, F);
-end;
-
-function TFileSystemImpl.FindNext(var F: TSytemSearchRec): integer;
-begin
- Result := WideFindNext(F);
-end;
-
-procedure TFileSystemImpl.FindClose(var F: TSytemSearchRec);
-begin
- WideFindClose(F);
-end;
-
-function TFileSystemImpl.GetCurrentDir: IPath;
-begin
- Result := Path(WideGetCurrentDir());
-end;
-
-function TFileSystemImpl.SetCurrentDir(const Dir: IPath): boolean;
-begin
- Result := WideSetCurrentDir(Dir.ToWide());
-end;
-
-{$ELSE} // UNIX
-
-function TFileSystemImpl.ExpandFileName(const FileName: IPath): IPath;
-begin
- Result := Path(SysUtils.ExpandFileName(FileName.ToNative()));
-end;
-
-function TFileSystemImpl.FileCreate(const FileName: IPath): THandle;
-begin
- Result := SysUtils.FileCreate(FileName.ToNative());
-end;
-
-function TFileSystemImpl.DirectoryCreate(const Dir: IPath): boolean;
-begin
- Result := SysUtils.CreateDir(Dir.ToNative());
-end;
-
-function TFileSystemImpl.FileOpen(const FileName: IPath; Mode: longword): THandle;
-begin
- Result := SysUtils.FileOpen(FileName.ToNative(), Mode);
-end;
-
-function TFileSystemImpl.FileAge(const FileName: IPath): integer;
-begin
- Result := SysUtils.FileAge(FileName.ToNative());
-end;
-
-function TFileSystemImpl.FileAge(const FileName: IPath; out FileDateTime: TDateTime): boolean;
-var
- FileDate: integer;
-begin
- FileDate := SysUtils.FileAge(FileName.ToNative());
- Result := (FileDate <> -1);
- if (Result) then
- FileDateTime := FileDateToDateTime(FileDate);
-end;
-
-function TFileSystemImpl.DirectoryExists(const Name: IPath): boolean;
-begin
- Result := SysUtils.DirectoryExists(Name.ToNative());
-end;
-
-function TFileSystemImpl.FileExists(const Name: IPath): boolean;
-begin
- Result := SysUtils.FileExists(Name.ToNative());
-end;
-
-function TFileSystemImpl.FileGetAttr(const FileName: IPath): Cardinal;
-begin
- Result := SysUtils.FileGetAttr(FileName.ToNative());
-end;
-
-function TFileSystemImpl.FileSetAttr(const FileName: IPath; Attr: integer): boolean;
-begin
- Result := (SysUtils.FileSetAttr(FileName.ToNative(), Attr) = 0);
-end;
-
-function TFileSystemImpl.FileIsReadOnly(const FileName: IPath): boolean;
-begin
- Result := SysUtils.FileIsReadOnly(FileName.ToNative());
-end;
-
-function TFileSystemImpl.FileSetReadOnly(const FileName: IPath; ReadOnly: boolean): boolean;
-begin
- Result := (SysUtils.FileSetAttr(FileName.ToNative(), faReadOnly) = 0);
-end;
-
-function TFileSystemImpl.ForceDirectories(const Dir: IPath): boolean;
-begin
- Result := SysUtils.ForceDirectories(Dir.ToNative());
-end;
-
-function TFileSystemImpl.FileSearch(const Name: IPath; DirList: array of IPath): IPath;
-var
- I: integer;
- DirListStr: AnsiString;
-begin
- DirListStr := '';
- for I := 0 to High(DirList) do
- begin
- if (I > 0) then
- DirListStr := DirListStr + PathSep;
- DirListStr := DirListStr + DirList[I].ToNative();
- end;
- Result := Path(SysUtils.FileSearch(Name.ToNative(), DirListStr));
-end;
-
-function TFileSystemImpl.RenameFile(const OldName, NewName: IPath): boolean;
-begin
- Result := SysUtils.RenameFile(OldName.ToNative(), NewName.ToNative());
-end;
-
-function TFileSystemImpl.DeleteFile(const FileName: IPath): boolean;
-begin
- Result := SysUtils.DeleteFile(FileName.ToNative());
-end;
-
-function TFileSystemImpl.RemoveDir(const Dir: IPath): boolean;
-begin
- Result := SysUtils.RemoveDir(Dir.ToNative());
-end;
-
-function TFileSystemImpl.CopyFile(const Source, Target: IPath; FailIfExists: boolean): boolean;
-const
- COPY_BUFFER_SIZE = 4096; // a good tradeoff between speed and memory consumption
-var
- SourceFile, TargetFile: TFileStream;
- FileCopyBuffer: array [0..COPY_BUFFER_SIZE-1] of byte; // temporary copy-buffer.
- NumberOfBytes: integer; // number of bytes read from SourceFile
-begin
- Result := false;
- SourceFile := nil;
- TargetFile := nil;
-
- // if overwrite is disabled return if the target file already exists
- if (FailIfExists and FileExists(Target)) then
- Exit;
-
- try
- try
- // open source and target file (might throw an exception on error)
- SourceFile := TFileStream.Create(Source.ToNative(), fmOpenRead);
- TargetFile := TFileStream.Create(Target.ToNative(), fmCreate or fmOpenWrite);
-
- while true do
- begin
- // read a block from the source file and check for errors or EOF
- NumberOfBytes := SourceFile.Read(FileCopyBuffer, SizeOf(FileCopyBuffer));
- if (NumberOfBytes <= 0) then
- Break;
- // write block to target file and check if everything was written
- if (TargetFile.Write(FileCopyBuffer, NumberOfBytes) <> NumberOfBytes) then
- Exit;
- end;
- except
- Exit;
- end;
- finally
- SourceFile.Free;
- TargetFile.Free;
- end;
-
- Result := true;
-end;
-
-function TFileSystemImpl.ExtractFileDrive(const FileName: IPath): IPath;
-begin
- Result := Path(SysUtils.ExtractFileDrive(FileName.ToNative()));
-end;
-
-function TFileSystemImpl.ExtractFilePath(const FileName: IPath): IPath;
-begin
- Result := Path(SysUtils.ExtractFilePath(FileName.ToNative()));
-end;
-
-function TFileSystemImpl.ExtractFileDir(const FileName: IPath): IPath;
-begin
- Result := Path(SysUtils.ExtractFileDir(FileName.ToNative()));
-end;
-
-function TFileSystemImpl.ExtractFileName(const FileName: IPath): IPath;
-begin
- Result := Path(SysUtils.ExtractFileName(FileName.ToNative()));
-end;
-
-function TFileSystemImpl.ExtractFileExt(const FileName: IPath): IPath;
-begin
- Result := Path(SysUtils.ExtractFileExt(FileName.ToNative()));
-end;
-
-function TFileSystemImpl.ExtractRelativePath(const BaseName: IPath; const FileName: IPath): IPath;
-begin
- Result := Path(SysUtils.ExtractRelativePath(BaseName.ToNative(), FileName.ToNative()));
-end;
-
-function TFileSystemImpl.ChangeFileExt(const FileName: IPath; const Extension: IPath): IPath;
-begin
- Result := Path(SysUtils.ChangeFileExt(FileName.ToNative(), Extension.ToNative()));
-end;
-
-function TFileSystemImpl.IncludeTrailingPathDelimiter(const FileName: IPath): IPath;
-begin
- Result := Path(SysUtils.IncludeTrailingPathDelimiter(FileName.ToNative()));
-end;
-
-function TFileSystemImpl.ExcludeTrailingPathDelimiter(const FileName: IPath): IPath;
-begin
- Result := Path(SysUtils.ExcludeTrailingPathDelimiter(FileName.ToNative()));
-end;
-
-function TFileSystemImpl.FindFirst(const FilePattern: IPath; Attr: integer; var F: TSytemSearchRec): integer;
-begin
- Result := SysUtils.FindFirst(FilePattern.ToNative(), Attr, F);
-end;
-
-function TFileSystemImpl.FindNext(var F: TSytemSearchRec): integer;
-begin
- Result := SysUtils.FindNext(F);
-end;
-
-procedure TFileSystemImpl.FindClose(var F: TSytemSearchRec);
-begin
- SysUtils.FindClose(F);
-end;
-
-function TFileSystemImpl.GetCurrentDir: IPath;
-begin
- Result := Path(SysUtils.GetCurrentDir());
-end;
-
-function TFileSystemImpl.SetCurrentDir(const Dir: IPath): boolean;
-begin
- Result := SysUtils.SetCurrentDir(Dir.ToNative());
-end;
-
-{$ENDIF}
-
-
-{ TFileIterator }
-
-constructor TFileIterator.Create(const FilePattern: IPath; Attr: integer);
-begin
- inherited Create();
- fHasNext := (FileSystem.FindFirst(FilePattern, Attr, fSearchRec) = 0);
-end;
-
-destructor TFileIterator.Destroy();
-begin
- FileSystem.FindClose(fSearchRec);
- inherited;
-end;
-
-function TFileIterator.HasNext(): boolean;
-begin
- Result := fHasNext;
-end;
-
-function TFileIterator.Next(): TFileInfo;
-begin
- if (not fHasNext) then
- begin
- // Note: do not use FillChar() on records with ref-counted fields
- Result.Time := 0;
- Result.Size := 0;
- Result.Attr := 0;
- Result.Name := nil;
- Exit;
- end;
-
- Result.Time := fSearchRec.Time;
- Result.Size := fSearchRec.Size;
- Result.Attr := fSearchRec.Attr;
- Result.Name := Path(fSearchRec.Name);
-
- // fetch next entry
- fHasNext := (FileSystem.FindNext(fSearchRec) = 0);
-end;
-
-
-initialization
- FileSystem_Singleton := TFileSystemImpl.Create;
-
-finalization
- FileSystem_Singleton := nil;
-
-end.
diff --git a/src/base/UFont.pas b/src/base/UFont.pas
deleted file mode 100644
index 191e74d2..00000000
--- a/src/base/UFont.pas
+++ /dev/null
@@ -1,2798 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UFont;
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-interface
-
-{$IFNDEF FREETYPE_DEMO}
- // Flip direction of y-axis.
- // Default is a cartesian coordinate system with y-axis in upper direction
- // but with USDX the y-axis is in lower direction.
- {$DEFINE FLIP_YAXIS}
- {$DEFINE BITMAP_FONT}
-{$ENDIF}
-
-uses
- FreeType,
- gl,
- glext,
- glu,
- sdl,
- Math,
- Classes,
- SysUtils,
- UUnicodeUtils,
- {$IFDEF BITMAP_FONT}
- UTexture,
- {$ENDIF}
- UPath;
-
-type
-
- PGLubyteArray = ^TGLubyteArray;
- TGLubyteArray = array[0 .. (MaxInt div SizeOf(GLubyte))-1] of GLubyte;
- TGLubyteDynArray = array of GLubyte;
-
- TUCS4StringArray = array of UCS4String;
-
- TGLColor = packed record
- case byte of
- 0: ( vals: array[0..3] of GLfloat; );
- 1: ( r, g, b, a: GLfloat; );
- end;
-
- TBoundsDbl = record
- Left, Right: double;
- Bottom, Top: double;
- end;
-
- TPositionDbl = record
- X, Y: double;
- end;
-
- TTextureSize = record
- Width, Height: integer;
- end;
-
- TBitmapCoords = record
- Left, Top: double;
- Width, Height: integer;
- end;
-
- {**
- * Abstract base class representing a glyph.
- *}
- TGlyph = class
- protected
- function GetAdvance(): TPositionDbl; virtual; abstract;
- function GetBounds(): TBoundsDbl; virtual; abstract;
- public
- procedure Render(UseDisplayLists: boolean); virtual; abstract;
- procedure RenderReflection(); virtual; abstract;
-
- {** Distance to next glyph (in pixels) *}
- property Advance: TPositionDbl read GetAdvance;
- {** Glyph bounding box (in pixels) *}
- property Bounds: TBoundsDbl read GetBounds;
- end;
-
- {**
- * Font styles used by TFont.Style
- *}
- TFontStyle = set of (Italic, Underline, Reflect);
-
- {**
- * Base font class.
- *}
- TFont = class
- private
- {** Non-virtual reset-method used in Create() and Reset() }
- procedure ResetIntern();
-
- protected
- fStyle: TFontStyle;
- fUseKerning: boolean;
- fLineSpacing: single; // must be inited by subclass
- fReflectionSpacing: single; // must be inited by subclass to -2*Descender
- fGlyphSpacing: single;
- fReflectionPass: boolean;
-
- {**
- * Splits lines in Text seperated by newline (char-code #13).
- * @param Text UCS-4 encoded string
- * @param Lines splitted UCS4String lines
- *}
- procedure SplitLines(const Text: UCS4String; var Lines: TUCS4StringArray);
-
- {**
- * Print an array of UCS4Strings. Each array-item is a line of text.
- * Lines of text are seperated by the line-spacing.
- * This is the base function for all text drawing.
- *}
- procedure Print(const Text: TUCS4StringArray); overload; virtual;
-
- {**
- * Draws an underline.
- *}
- procedure DrawUnderline(const Text: UCS4String); virtual;
-
- {**
- * Renders (one) line of text.
- *}
- procedure Render(const Text: UCS4String); virtual; abstract;
-
- {**
- * Returns the bounds of text-lines contained in Text.
- * @param(Advance if true the right bound is set to the advance instead
- * of the minimal right bound.)
- *}
- function BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; overload; virtual; abstract;
-
- {**
- * Resets all user settings to default values.
- * Override methods should always call the inherited version.
- *}
- procedure Reset(); virtual;
-
- function GetHeight(): single; virtual; abstract;
- function GetAscender(): single; virtual; abstract;
- function GetDescender(): single; virtual; abstract;
- procedure SetLineSpacing(Spacing: single); virtual;
- function GetLineSpacing(): single; virtual;
- procedure SetGlyphSpacing(Spacing: single); virtual;
- function GetGlyphSpacing(): single; virtual;
- procedure SetReflectionSpacing(Spacing: single); virtual;
- function GetReflectionSpacing(): single; virtual;
- procedure SetStyle(Style: TFontStyle); virtual;
- function GetStyle(): TFontStyle; virtual;
- function GetUnderlinePosition(): single; virtual; abstract;
- function GetUnderlineThickness(): single; virtual; abstract;
- procedure SetUseKerning(Enable: boolean); virtual;
- function GetUseKerning(): boolean; virtual;
- procedure SetReflectionPass(Enable: boolean); virtual;
-
- {** Returns true if the current render-pass is used to draw the reflection }
- property ReflectionPass: boolean read fReflectionPass write SetReflectionPass;
-
- public
- constructor Create();
- destructor Destroy(); override;
-
- {**
- * Prints a text.
- *}
- procedure Print(const Text: UCS4String); overload;
- {** UTF-16 version of @link(Print) }
- procedure Print(const Text: WideString); overload;
- {** UTF-8 version of @link(Print) }
- procedure Print(const Text: UTF8String); overload;
-
- {**
- * Calculates the bounding box (width and height) around Text.
- * Works with Italic and Underline styles but reflections created
- * with the Reflect style are not considered.
- * Note that the width might differ due to kerning with appended text,
- * e.g. Width('VA') <= Width('V') + Width('A').
- * @param Advance if set to true, Result.Right is set to the advance of
- * the given text rather than the min. right border. The advance width is
- * bigger than the text's width as it additionally contains the advance
- * and glyph-spacing of the last character.
- *}
- function BBox(const Text: UCS4String; Advance: boolean = true): TBoundsDbl; overload;
- {** UTF-16 version of @link(BBox) }
- function BBox(const Text: WideString; Advance: boolean = true): TBoundsDbl; overload;
- {** UTF-8 version of @link(BBox) }
- function BBox(const Text: UTF8String; Advance: boolean = true): TBoundsDbl; overload;
-
- {** Font height }
- property Height: single read GetHeight;
- {** Vertical distance from baseline to top of glyph }
- property Ascender: single read GetAscender;
- {** Vertical distance from baseline to bottom of glyph }
- property Descender: single read GetDescender;
- {** Vertical distance between two baselines }
- property LineSpacing: single read GetLineSpacing write SetLineSpacing;
- {** Space between end and start of next glyph added to the advance width }
- property GlyphSpacing: single read GetGlyphSpacing write SetGlyphSpacing;
- {** Distance between normal baseline and baseline of the reflection }
- property ReflectionSpacing: single read GetReflectionSpacing write SetReflectionSpacing;
- {** Font style (italic/underline/...) }
- property Style: TFontStyle read GetStyle write SetStyle;
- {** If set to true (default) kerning will be used if available }
- property UseKerning: boolean read GetUseKerning write SetUseKerning;
- end;
-
-const
- //** Max. number of mipmap levels that a TScalableFont can contain
- cMaxMipmapLevel = 5;
-
-type
- {**
- * Wrapper around TFont to allow font size changes.
- * The font is scaled to the requested size by a modelview matrix
- * transformation (glScale) and not by rescaling the internal bitmap
- * representation. This way changing the size is really fast but the result
- * may lack quality on large or small scale factors.
- *}
- TScalableFont = class(TFont)
- private
- procedure ResetIntern();
-
- protected
- fScale: single; //**< current height to base-font height ratio
- fAspect: single; //**< width to height aspect
- fBaseFont: TFont; //**< shortcut for fMipmapFonts[0]
- fUseMipmaps: boolean; //**< true if mipmap fonts are generated
- /// Mipmap fonts (size[level+1] = size[level]/2)
- fMipmapFonts: array[0..cMaxMipmapLevel] of TFont;
-
- procedure Render(const Text: UCS4String); override;
- procedure Print(const Text: TUCS4StringArray); override;
- function BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; override;
-
- {**
- * Callback called for creation of each mipmap font.
- * Must be defined by the subclass.
- * Mipmaps created by this method are managed and freed by TScalableFont.
- *}
- function CreateMipmap(Level: integer; Scale: single): TFont; virtual; abstract;
-
- {**
- * Returns the mipmap level considering the current scale and projection
- * matrix.
- *}
- function GetMipmapLevel(): integer;
-
- {**
- * Returns the scale applied to the given mipmap font.
- * fScale * fBaseFont.Height / fMipmapFont[Level].Height
- *}
- function GetMipmapScale(Level: integer): single;
-
- {**
- * Chooses the mipmap that looks nicest with current scale and projection
- * matrix.
- *}
- function ChooseMipmapFont(): TFont;
-
- procedure SetHeight(Height: single); virtual;
- function GetHeight(): single; override;
- procedure SetAspect(Aspect: single); virtual;
- function GetAspect(): single; virtual;
- function GetAscender(): single; override;
- function GetDescender(): single; override;
- procedure SetLineSpacing(Spacing: single); override;
- function GetLineSpacing(): single; override;
- procedure SetGlyphSpacing(Spacing: single); override;
- function GetGlyphSpacing(): single; override;
- procedure SetReflectionSpacing(Spacing: single); override;
- function GetReflectionSpacing(): single; override;
- procedure SetStyle(Style: TFontStyle); override;
- function GetStyle(): TFontStyle; override;
- function GetUnderlinePosition(): single; override;
- function GetUnderlineThickness(): single; override;
- procedure SetUseKerning(Enable: boolean); override;
-
- public
- {**
- * Creates a wrapper to make the base-font Font scalable.
- * If UseMipmaps is set to true smaller fonts are created so that a
- * resized (Height property changed) font looks nicer.
- * The font passed is managed and freed by TScalableFont.
- *}
- constructor Create(Font: TFont; UseMipmaps: boolean); overload;
-
- {**
- * Frees memory. The fonts passed on Create() and mipmap creation
- * are freed too.
- *}
- destructor Destroy(); override;
-
- {** @seealso TFont.Reset }
- procedure Reset(); override;
-
- {** Font height }
- property Height: single read GetHeight write SetHeight;
- {** Factor for font stretching (NewWidth = Width*Aspect), 1.0 by default }
- property Aspect: single read GetAspect write SetAspect;
- end;
-
- {**
- * Table for storage of max. 256 glyphs.
- * Used for the second cache level. Indexed by the LSB of the UCS4Char
- * char-code.
- *}
- PGlyphTable = ^TGlyphTable;
- TGlyphTable = array[0..255] of TGlyph;
-
- {**
- * Cache for glyphs of a single font.
- * The cached glyphs are stored inside a hash-list.
- * Hashing is performed in two steps:
- * 1. the least significant byte (LSB) of the UCS4Char character code
- * is removed (shr 8) and the result (we call it BaseCode here) looked up in
- * the hash-list.
- * 2. Each entry of the hash-list contains a table with max. 256 entries.
- * The LSB of the char-code of a glyph is the table-offset of that glyph.
- *}
- TGlyphCache = class
- private
- fHash: TList;
-
- {**
- * Finds a glyph-table storing cached glyphs with base-code BaseCode
- * (= upper char-code bytes) in the hash-list and returns the table and
- * its index.
- * @param(InsertPos the position of the tyble in the list if it was found,
- * otherwise the position the table should be inserted)
- *}
- function FindGlyphTable(BaseCode: cardinal; out InsertPos: integer): PGlyphTable;
-
- public
- constructor Create();
- destructor Destroy(); override;
-
- {**
- * Add glyph Glyph with char-code ch to the cache.
- * @returns @true on success, @false otherwise
- *}
- function AddGlyph(ch: UCS4Char; const Glyph: TGlyph): boolean;
-
- {**
- * Removes the glyph with char-code ch from the cache.
- *}
- procedure DeleteGlyph(ch: UCS4Char);
-
- {**
- * Removes the glyph with char-code ch from the cache.
- *}
- function GetGlyph(ch: UCS4Char): TGlyph;
-
- {**
- * Checks if a glyph with char-code ch is cached.
- *}
- function HasGlyph(ch: UCS4Char): boolean;
-
- {**
- * Remove and free all cached glyphs. If KeepBaseSet is set to
- * true, cached characters in the range 0..255 will not be flushed.
- *}
- procedure FlushCache(KeepBaseSet: boolean);
- end;
-
- {**
- * Entry of a glyph-cache's (TGlyphCache) hash.
- * Stores a BaseCode (upper-bytes of a glyph's char-code) and a table
- * with all glyphs cached at the moment with that BaseCode.
- *}
- TGlyphCacheHashEntry = class
- private
- fBaseCode: cardinal;
- public
- GlyphTable: TGlyphTable;
-
- constructor Create(BaseCode: cardinal);
-
- {** Base-code (upper-bytes) of the glyphs stored in this entry's table }
- property BaseCode: cardinal read fBaseCode;
- end;
-
- TCachedFont = class(TFont)
- protected
- fCache: TGlyphCache;
-
- {**
- * Retrieves a cached glyph with char-code ch from cache.
- * If the glyph is not already cached, it is loaded with LoadGlyph().
- *}
- function GetGlyph(ch: UCS4Char): TGlyph;
-
- {**
- * Callback to create (load) a glyph with char-code ch.
- * Implemented by subclasses.
- *}
- function LoadGlyph(ch: UCS4Char): TGlyph; virtual; abstract;
-
- public
- constructor Create();
- destructor Destroy(); override;
-
- {**
- * Remove and free all cached glyphs. If KeepBaseSet is set to
- * true, the base glyphs are not be flushed.
- * @seealso TGlyphCache.FlushCache
- *}
- procedure FlushCache(KeepBaseSet: boolean);
- end;
-
- TFTFont = class;
-
- {**
- * Freetype glyph.
- * Each glyph stores a texture with the glyph's image.
- *}
- TFTGlyph = class(TGlyph)
- private
- fCharCode: UCS4Char; //**< Char code
- fCharIndex: FT_UInt; //**< Freetype specific char-index (<> char-code)
- fDisplayList: GLuint; //**< Display-list ID
- fTexture: GLuint; //**< Texture ID
- fBitmapCoords: TBitmapCoords; //**< Left/Top offset and Width/Height of the bitmap (in pixels)
- fTexOffset: TPositionDbl; //**< Right and bottom texture offset for removal of power-of-2 padding
- fTexSize: TTextureSize; //**< Texture size in pixels
-
- fFont: TFTFont; //**< Font associated with this glyph
- fAdvance: TPositionDbl; //**< Advance width of this glyph
- fBounds: TBoundsDbl; //**< Glyph bounds
- fOutset: single; //**< Extrusion outset
-
- {**
- * Extrudes the outline of a glyph's bitmap stored in TexBuffer with size
- * fTexSize by Outset pixels.
- * This is useful to create bold or outlined fonts.
- * TexBuffer must be 2*Ceil(Outset) pixels higher and wider than the
- * original glyph bitmap, otherwise the glyph borders cannot be extruded
- * correctly.
- * The bitmap must be 2* pixels wider and higher than the
- * original glyph's bitmap with the latter centered in it.
- *}
- procedure StrokeBorder(var Glyph: FT_Glyph);
-
- {**
- * Creates an OpenGL texture (and display list) for the glyph.
- * The glyph's and bitmap's metrics are set correspondingly.
- * @param LoadFlags flags passed to FT_Load_Glyph()
- * @raises Exception if the glyph could not be initialized
- *}
- procedure CreateTexture(LoadFlags: FT_Int32);
-
- protected
- function GetAdvance(): TPositionDbl; override;
- function GetBounds(): TBoundsDbl; override;
-
- public
- {**
- * Creates a glyph with char-code ch from font Font.
- * @param LoadFlags flags passed to FT_Load_Glyph()
- *}
- constructor Create(Font: TFTFont; ch: UCS4Char; Outset: single;
- LoadFlags: FT_Int32);
- destructor Destroy(); override;
-
- {** Renders the glyph (normal render pass) }
- procedure Render(UseDisplayLists: boolean); override;
- {** Renders the glyph's reflection }
- procedure RenderReflection(); override;
-
- {** Freetype specific char-index (<> char-code) }
- property CharIndex: FT_UInt read fCharIndex;
- end;
-
- TFontPart = ( fpNone, fpInner, fpOutline );
-
- {**
- * Freetype font class.
- *}
- TFTFont = class(TCachedFont)
- private
- procedure ResetIntern();
-
- protected
- fFilename: IPath; //**< filename of the font-file
- fSize: integer; //**< Font base size (in pixels)
- fOutset: single; //**< size of outset extrusion (in pixels)
- fFace: FT_Face; //**< Holds the height of the font
- fLoadFlags: FT_Int32; //**< FT glpyh load-flags
- fFontUnitScale: TPositionDbl; //**< FT font-units to pixel ratio
- fUseDisplayLists: boolean; //**< true: use display-lists, false: direct drawing
- fPart: TFontPart; //**< indicates the part of an outline font
-
- {** @seealso TCachedFont.LoadGlyph }
- function LoadGlyph(ch: UCS4Char): TGlyph; override;
-
- procedure Render(const Text: UCS4String); override;
- function BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; override;
-
- function GetHeight(): single; override;
- function GetAscender(): single; override;
- function GetDescender(): single; override;
- function GetUnderlinePosition(): single; override;
- function GetUnderlineThickness(): single; override;
-
- property Face: FT_Face read fFace;
-
- public
- {**
- * Creates a font of size Size (in pixels) from the file Filename.
- * If Outset (in pixels) is set to a value > 0 the glyphs will be extruded
- * at their borders. Use it for e.g. a bold effect.
- * @param LoadFlags flags passed to FT_Load_Glyph()
- * @raises Exception if the font-file could not be loaded
- *}
- constructor Create(const Filename: IPath;
- Size: integer; Outset: single = 0.0;
- LoadFlags: FT_Int32 = FT_LOAD_DEFAULT);
-
- {**
- * Frees all resources associated with the font.
- *}
- destructor Destroy(); override;
-
- {** @seealso TFont.Reset }
- procedure Reset(); override;
-
- {** Size of the base font }
- property Size: integer read fSize;
- {** Outset size }
- property Outset: single read fOutset;
- end;
-
- TFTScalableFont = class(TScalableFont)
- protected
- function GetOutset(): single; virtual;
- function CreateMipmap(Level: integer; Scale: single): TFont; override;
-
- public
- {**
- * Creates a scalable font of size Size (in pixels) from the file Filename.
- * OutsetAmount is the ratio of the glyph extrusion.
- * The extrusion in pixels is Size*OutsetAmount
- * (0.0 -> no extrusion, 0.1 -> 10%).
- *}
- constructor Create(const Filename: IPath;
- Size: integer; OutsetAmount: single = 0.0;
- UseMipmaps: boolean = true);
-
- {** @seealso TGlyphCache.FlushCache }
- procedure FlushCache(KeepBaseSet: boolean);
-
- {** Outset size (in pixels) of the scaled font }
- property Outset: single read GetOutset;
- end;
-
-
- {**
- * Represents a freetype font with an additional outline around its glyphs.
- * The outline size is passed on creation and cannot be changed later.
- *}
- TFTOutlineFont = class(TFont)
- private
- fFilename: IPath;
- fSize: integer;
- fOutset: single;
- fInnerFont, fOutlineFont: TFTFont;
- fOutlineColor: TGLColor;
-
- procedure ResetIntern();
-
- protected
- procedure DrawUnderline(const Text: UCS4String); override;
- procedure Render(const Text: UCS4String); override;
- function BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; override;
-
- function GetHeight(): single; override;
- function GetAscender(): single; override;
- function GetDescender(): single; override;
- procedure SetLineSpacing(Spacing: single); override;
- procedure SetGlyphSpacing(Spacing: single); override;
- procedure SetReflectionSpacing(Spacing: single); override;
- procedure SetStyle(Style: TFontStyle); override;
- function GetStyle(): TFontStyle; override;
- function GetUnderlinePosition(): single; override;
- function GetUnderlineThickness(): single; override;
- procedure SetUseKerning(Enable: boolean); override;
- procedure SetReflectionPass(Enable: boolean); override;
-
- public
- constructor Create(const Filename: IPath;
- Size: integer; Outset: single;
- LoadFlags: FT_Int32 = FT_LOAD_DEFAULT);
- destructor Destroy; override;
-
- {**
- * Sets the color of the outline.
- * If the alpha component is < 0, OpenGL's current alpha value will be
- * used.
- *}
- procedure SetOutlineColor(r, g, b: GLfloat; a: GLfloat = -1.0);
-
- {** @seealso TGlyphCache.FlushCache }
- procedure FlushCache(KeepBaseSet: boolean);
-
- {** @seealso TFont.Reset }
- procedure Reset(); override;
-
- {** Size of the base font }
- property Size: integer read fSize;
- {** Outset size }
- property Outset: single read fOutset;
- end;
-
- {**
- * Wrapper around TOutlineFont to allow font resizing.
- * @seealso TScalableFont
- *}
- TFTScalableOutlineFont = class(TScalableFont)
- protected
- function GetOutset(): single; virtual;
- function CreateMipmap(Level: integer; Scale: single): TFont; override;
-
- public
- constructor Create(const Filename: IPath;
- Size: integer; OutsetAmount: single;
- UseMipmaps: boolean = true);
-
- {** @seealso TFTOutlineFont.SetOutlineColor }
- procedure SetOutlineColor(r, g, b: GLfloat; a: GLfloat = -1.0);
-
- {** @seealso TGlyphCache.FlushCache }
- procedure FlushCache(KeepBaseSet: boolean);
-
- {** Outset size }
- property Outset: single read GetOutset;
- end;
-
-{$IFDEF BITMAP_FONT}
-
- {**
- * A bitmapped font loads it's glyphs from a bitmap and stores them in a
- * texture. Unicode characters are not supported (but could be by supporting
- * multiple textures each storing a subset of unicode glyphs).
- * For backward compatibility only.
- *}
- TBitmapFont = class(TFont)
- private
- fTex: TTexture;
- fTexSize: integer;
- fBaseline: integer;
- fAscender: integer;
- fDescender: integer;
- fWidths: array[0..255] of byte; //**< half widths
- fOutline: integer;
- fTempColor: TGLColor; //**< colours for the reflection
-
- procedure ResetIntern();
-
- procedure RenderChar(ch: UCS4Char; var AdvanceX: real);
-
- {**
- * Load font widths from an info file.
- * @param InfoFile the name of the info (.dat) file
- * @raises Exception if the file is corrupted
- *}
- procedure LoadFontInfo(const InfoFile: IPath);
-
- protected
- procedure Render(const Text: UCS4String); override;
- function BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; override;
-
- function GetHeight(): single; override;
- function GetAscender(): single; override;
- function GetDescender(): single; override;
- function GetUnderlinePosition(): single; override;
- function GetUnderlineThickness(): single; override;
-
- public
- {**
- * Creates a bitmapped font from image Filename and font width info
- * loaded from the corresponding file with ending .dat.
- * @param(Baseline y-coord of the baseline given in cartesian coords
- * (y-axis up) and from the lower edge of the glyphs bounding box)
- * @param(Ascender pixels from baseline to top of highest glyph)
- *}
- constructor Create(const Filename: IPath; Outline: integer;
- Baseline, Ascender, Descender: integer);
- destructor Destroy(); override;
-
- {**
- * Corrects font widths provided by the info file.
- * NewWidth := Width * WidthMult + WidthAdd
- *}
- procedure CorrectWidths(WidthMult: real; WidthAdd: integer);
-
- {** @seealso TFont.Reset }
- procedure Reset(); override;
- end;
-
-{$ENDIF BITMAP_FONT}
-
- TFreeType = class
- public
- {**
- * Returns a pointer to the freetype library singleton.
- * If non exists, freetype will be initialized.
- * @raises Exception if initialization failed
- *}
- class function GetLibrary(): FT_Library;
- class procedure FreeLibrary();
- end;
-
-
-implementation
-
-uses Types;
-
-const
- //** shear factor used for the italic effect (bigger value -> more bending)
- cShearFactor = 0.25;
- cShearMatrix: array[0..15] of GLfloat = (
- 1, 0, 0, 0,
- cShearFactor, 1, 0, 0,
- 0, 0, 1, 0,
- 0, 0, 0, 1
- );
- cShearMatrixInv: array[0..15] of GLfloat = (
- 1, 0, 0, 0,
- -cShearFactor, 1, 0, 0,
- 0, 0, 1, 0,
- 0, 0, 0, 1
- );
-
-var
- LibraryInst: FT_Library;
-
-function NewGLColor(r, g, b, a: GLfloat): TGLColor;
-begin
- Result.r := r;
- Result.g := g;
- Result.b := b;
- Result.a := a;
-end;
-
-{**
- * Returns the first power of 2 >= Value.
- *}
-function NextPowerOf2(Value: integer): integer; {$IFDEF HasInline}inline;{$ENDIF}
-begin
- Result := 1;
- while (Result < Value) do
- Result := Result shl 1;
-end;
-
-
-{*
- * TFont
- *}
-
-constructor TFont.Create();
-begin
- inherited;
- ResetIntern();
-end;
-
-destructor TFont.Destroy();
-begin
- inherited;
-end;
-
-procedure TFont.ResetIntern();
-begin
- fStyle := [];
- fUseKerning := true;
- fGlyphSpacing := 0.0;
- fReflectionPass := false;
-
- // must be set by subclasses
- fLineSpacing := 0.0;
- fReflectionSpacing := 0.0;
-end;
-
-procedure TFont.Reset();
-begin
- ResetIntern();
-end;
-
-procedure TFont.SplitLines(const Text: UCS4String; var Lines: TUCS4StringArray);
-var
- CharIndex: integer;
- LineStart: integer;
- LineLength: integer;
- EOT: boolean; // End-Of-Text
-begin
- // split lines on newline
- SetLength(Lines, 0);
- EOT := false;
- LineStart := 0;
-
- for CharIndex := 0 to High(Text) do
- begin
- // check for end of text (UCS4Strings are zero-terminated)
- if (CharIndex = High(Text)) then
- EOT := true;
-
- // check for newline (carriage return (#13)) or end of text
- if (Text[CharIndex] = 13) or EOT then
- begin
- LineLength := CharIndex - LineStart;
- // check if last character was a newline
- if (EOT and (LineLength = 0)) then
- Break;
-
- // copy line (even if LineLength is 0)
- SetLength(Lines, Length(Lines)+1);
- Lines[High(Lines)] := UCS4Copy(Text, LineStart, LineLength);
-
- LineStart := CharIndex+1;
- end;
- end;
-end;
-
-function TFont.BBox(const Text: UCS4String; Advance: boolean): TBoundsDbl;
-var
- LineArray: TUCS4StringArray;
-begin
- SplitLines(Text, LineArray);
- Result := BBox(LineArray, Advance);
- SetLength(LineArray, 0);
-end;
-
-function TFont.BBox(const Text: UTF8String; Advance: boolean): TBoundsDbl;
-begin
- Result := BBox(UTF8Decode(Text), Advance);
-end;
-
-function TFont.BBox(const Text: WideString; Advance: boolean): TBoundsDbl;
-begin
- Result := BBox(WideStringToUCS4String(Text), Advance);
-end;
-
-procedure TFont.Print(const Text: TUCS4StringArray);
-var
- LineIndex: integer;
-begin
- // recursively call this function to draw reflected text
- if ((Reflect in Style) and not ReflectionPass) then
- begin
- ReflectionPass := true;
- Print(Text);
- ReflectionPass := false;
- end;
-
- // store current color, enable-flags, matrix-mode
- glPushAttrib(GL_CURRENT_BIT or GL_ENABLE_BIT or GL_TRANSFORM_BIT);
-
- // set OpenGL state
- glMatrixMode(GL_MODELVIEW);
- glDisable(GL_DEPTH_TEST);
- glEnable(GL_BLEND);
- glEnable(GL_TEXTURE_2D);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
-
- {
- // TODO: just draw texels with alpha > 0 to avoid setting z-buffer for them?
- glAlphaFunc(GL_GREATER, 0);
- glEnable(GL_ALPHA_TEST);
-
- //TODO: Do we need depth-testing?
- if (ReflectionPass) then
- begin
- glDepthMask(0);
- glEnable(GL_DEPTH_TEST);
- end;
- }
-
- {$IFDEF FLIP_YAXIS}
- glPushMatrix();
- glScalef(1, -1, 1);
- {$ENDIF}
-
- // display text
- for LineIndex := 0 to High(Text) do
- begin
- glPushMatrix();
-
- // move to baseline
- glTranslatef(0, -LineSpacing*LineIndex, 0);
-
- if ((Underline in Style) and not ReflectionPass) then
- begin
- glDisable(GL_TEXTURE_2D);
- DrawUnderline(Text[LineIndex]);
- glEnable(GL_TEXTURE_2D);
- end;
-
- // draw reflection
- if (ReflectionPass) then
- begin
- // set reflection spacing
- glTranslatef(0, -ReflectionSpacing, 0);
- // flip y-axis
- glScalef(1, -1, 1);
- end;
-
- // shear for italic effect
- if (Italic in Style) then
- glMultMatrixf(@cShearMatrix);
-
- // render text line
- Render(Text[LineIndex]);
-
- glPopMatrix();
- end;
-
- // restore settings
- {$IFDEF FLIP_YAXIS}
- glPopMatrix();
- {$ENDIF}
- glPopAttrib();
-end;
-
-procedure TFont.Print(const Text: UCS4String);
-var
- LineArray: TUCS4StringArray;
-begin
- SplitLines(Text, LineArray);
- Print(LineArray);
- SetLength(LineArray, 0);
-end;
-
-procedure TFont.Print(const Text: UTF8String);
-begin
- Print(UTF8Decode(Text));
-end;
-
-procedure TFont.Print(const Text: WideString);
-begin
- Print(WideStringToUCS4String(Text));
-end;
-
-procedure TFont.DrawUnderline(const Text: UCS4String);
-var
- UnderlineY1, UnderlineY2: single;
- Bounds: TBoundsDbl;
-begin
- UnderlineY1 := GetUnderlinePosition();
- UnderlineY2 := UnderlineY1 + GetUnderlineThickness();
- Bounds := BBox(Text, false);
- glRectf(Bounds.Left, UnderlineY1, Bounds.Right, UnderlineY2);
-end;
-
-procedure TFont.SetStyle(Style: TFontStyle);
-begin
- fStyle := Style;
-end;
-
-function TFont.GetStyle(): TFontStyle;
-begin
- Result := fStyle;
-end;
-
-procedure TFont.SetLineSpacing(Spacing: single);
-begin
- fLineSpacing := Spacing;
-end;
-
-function TFont.GetLineSpacing(): single;
-begin
- Result := fLineSpacing;
-end;
-
-procedure TFont.SetGlyphSpacing(Spacing: single);
-begin
- fGlyphSpacing := Spacing;
-end;
-
-function TFont.GetGlyphSpacing(): single;
-begin
- Result := fGlyphSpacing;
-end;
-
-procedure TFont.SetReflectionSpacing(Spacing: single);
-begin
- fReflectionSpacing := Spacing;
-end;
-
-function TFont.GetReflectionSpacing(): single;
-begin
- Result := fReflectionSpacing;
-end;
-
-procedure TFont.SetUseKerning(Enable: boolean);
-begin
- fUseKerning := Enable;
-end;
-
-function TFont.GetUseKerning(): boolean;
-begin
- Result := fUseKerning;
-end;
-
-procedure TFont.SetReflectionPass(Enable: boolean);
-begin
- fReflectionPass := Enable;
-end;
-
-
-{*
- * TScalableFont
- *}
-
-constructor TScalableFont.Create(Font: TFont; UseMipmaps: boolean);
-var
- MipmapLevel: integer;
-begin
- inherited Create();
-
- fBaseFont := Font;
- fMipmapFonts[0] := Font;
- fUseMipmaps := UseMipmaps;
- ResetIntern();
-
- // create mipmap fonts if requested
- if (UseMipmaps) then
- begin
- for MipmapLevel := 1 to cMaxMipmapLevel do
- begin
- fMipmapFonts[MipmapLevel] := CreateMipmap(MipmapLevel, 1/(1 shl MipmapLevel));
- // stop if no smaller mipmap font is returned
- if (fMipmapFonts[MipmapLevel] = nil) then
- Break;
- end;
- end;
-end;
-
-destructor TScalableFont.Destroy();
-var
- Level: integer;
-begin
- for Level := 0 to High(fMipmapFonts) do
- fMipmapFonts[Level].Free;
- inherited;
-end;
-
-procedure TScalableFont.ResetIntern();
-begin
- fScale := 1.0;
- fAspect := 1.0;
-end;
-
-procedure TScalableFont.Reset();
-var
- Level: integer;
-begin
- inherited;
- ResetIntern();
- for Level := 0 to High(fMipmapFonts) do
- if (fMipmapFonts[Level] <> nil) then
- fMipmapFonts[Level].Reset();
-end;
-
-{**
- * Returns the mipmap level to use with regard to the current projection
- * and modelview matrix, font scale and aspect.
- *
- * Note:
- * - for Freetype fonts, hinting and grid-fitting must be disabled, otherwise
- * the glyph widths/heights ratios and advance widths of the mipmap fonts
- * do not match as they are adjusted sligthly (e.g. an 'a' at size 12px has
- * width 12px, but at size 6px width 8px).
- * - returned mipmap-level is used for all glyphs of the current text to print.
- * This is faster, much easier to handle, since we just need to create
- * multiple sized fonts and select the one we need for the mipmap-level and
- * it avoids that neighbored glyphs use different mipmap-level which might
- * look odd because one glyph might look blurry and the other sharp.
- *
- * Motivation:
- * We do not use OpenGL for mipmapping as the results are very bad. At least
- * with automatic mipmap generation (gluBuildMipmaps) the fonts look rather
- * blurry.
- * Defining our own mipmaps by creating multiple textures with
- * for different mimap levels is a pain, as the font size passed to freetype
- * is not the size of the bitmaps created and it does not guarantee that a
- * glyph bitmap of a font with font-size s/2 is half the size of the font with
- * font-size s. If the bitmap size is just a single pixel bigger than the half
- * we might need a texture of the next power-of-2 and the texture would not be
- * half of the size of the next bigger mipmap. In addition we use a fixed one
- * pixel sized border to smooth the texture (see cTexSmoothBorder) and maybe
- * an outset that is added to the font, so creating a glyph mipmap that is
- * exactly half the size of the next bigger one is a very difficult task.
- *
- * Solution:
- * Use mipmap textures that are not exactly half the size of the next mipmap
- * level. OpenGL does not support this (at least not without extensions).
- * The trickiest task is to determine the mipmap to use by calculating the
- * amount of minification that is performed in this function.
- *}
-function TScalableFont.GetMipmapLevel(): integer;
-var
- ModelMatrix, ProjMatrix: T16dArray;
- WinCoords: array[0..2, 0..2] of GLdouble;
- ViewPortArray: TViewPortArray;
- Dist, Dist2: double;
- WidthScale, HeightScale: double;
-const
- // width/height of square used for determining the scale
- cTestSize = 10.0;
- // an offset to the mipmap-level to adjust the change-over of two consecutive
- // mipmap levels. If for example the bias is 0.1 and unbiased level is 1.9
- // the result level will be 2. A bias of 0.5 is equal to rounding.
- // With bias=0.1 we prefer larger mipmaps over smaller ones.
- cBias = 0.2;
-begin
- // 1. retrieve current transformation matrices for gluProject
- glGetDoublev(GL_MODELVIEW_MATRIX, @ModelMatrix);
- glGetDoublev(GL_PROJECTION_MATRIX, @ProjMatrix);
- glGetIntegerv(GL_VIEWPORT, @ViewPortArray);
-
- // 2. project three of the corner points of a square with size cTestSize
- // to window coordinates (the square is just a dummy for a glyph)
-
- // project point (x1, y1) to window corrdinates
- gluProject(0, 0, 0,
- ModelMatrix, ProjMatrix, ViewPortArray,
- @WinCoords[0][0], @WinCoords[0][1], @WinCoords[0][2]);
- // project point (x2, y1) to window corrdinates
- gluProject(cTestSize, 0, 0,
- ModelMatrix, ProjMatrix, ViewPortArray,
- @WinCoords[1][0], @WinCoords[1][1], @WinCoords[1][2]);
- // project point (x1, y2) to window corrdinates
- gluProject(0, cTestSize, 0,
- ModelMatrix, ProjMatrix, ViewPortArray,
- @WinCoords[2][0], @WinCoords[2][1], @WinCoords[2][2]);
-
- // 3. Lets see how much the width and height of the square changed.
- // Calculate the width and height as displayed on the screen in window
- // coordinates and calculate the ratio to the original coordinates in
- // modelview space so the ratio gives us the scale (minification here).
-
- // projected width ||(x1, y1) - (x2, y1)||
- Dist := (WinCoords[0][0] - WinCoords[1][0]);
- Dist2 := (WinCoords[0][1] - WinCoords[1][1]);
-
- WidthScale := 1;
- if (Sqrt(Dist*Dist + Dist2*Dist2) <> 0) then
- begin
- WidthScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2);
- end;
-
- // projected height ||(x1, y1) - (x1, y2)||
- Dist := (WinCoords[0][0] - WinCoords[2][0]);
- Dist2 := (WinCoords[0][1] - WinCoords[2][1]);
-
- HeightScale := 1;
- if (Sqrt(Dist*Dist + Dist2*Dist2) <> 0) then
- begin
- HeightScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2);
- end;
-
- //writeln(Format('Scale %f, %f', [WidthScale, HeightScale]));
-
- // 4. Now that we have got the scale, take the bigger minification scale
- // and get it to a logarithmic scale as each mipmap is 1/2 the size of its
- // predecessor (Mipmap_size[i] = Mipmap_size[i-1]/2).
- // The result is our mipmap-level = the index of the mipmap to use.
-
- // Level > 0: Minification; < 0: Magnification
- Result := Trunc(Log2(Max(WidthScale, HeightScale)) + cBias);
-
- // clamp to valid range
- if (Result < 0) then
- Result := 0;
- if (Result > High(fMipmapFonts)) then
- Result := High(fMipmapFonts);
-end;
-
-function TScalableFont.GetMipmapScale(Level: integer): single;
-begin
- if (fMipmapFonts[Level] = nil) then
- begin
- Result := -1;
- Exit;
- end;
-
- Result := fScale * fMipmapFonts[0].Height / fMipmapFonts[Level].Height;
-end;
-
-{**
- * Returns the correct mipmap font for the current scale and projection
- * matrix. The modelview scale is adjusted to the mipmap level, so
- * Result.Print() will display the font in the correct size.
- *}
-function TScalableFont.ChooseMipmapFont(): TFont;
-var
- DesiredLevel: integer;
- Level: integer;
- MipmapScale: single;
-begin
- Result := nil;
- DesiredLevel := GetMipmapLevel();
-
- // get the smallest mipmap available for the desired level
- // as not all levels must be assigned to a font.
- for Level := DesiredLevel downto 0 do
- begin
- if (fMipmapFonts[Level] <> nil) then
- begin
- Result := fMipmapFonts[Level];
- Break;
- end;
- end;
-
- // since the mipmap font (if level > 0) is smaller than the base-font
- // we have to scale to get its size right.
- MipmapScale := fMipmapFonts[0].Height/Result.Height;
- glScalef(MipmapScale, MipmapScale, 0);
-end;
-
-procedure TScalableFont.Print(const Text: TUCS4StringArray);
-begin
- glPushMatrix();
-
- // set scale and stretching
- glScalef(fScale * fAspect, fScale, 0);
-
- // print text
- if (fUseMipmaps) then
- ChooseMipmapFont().Print(Text)
- else
- fBaseFont.Print(Text);
-
- glPopMatrix();
-end;
-
-procedure TScalableFont.Render(const Text: UCS4String);
-begin
- Assert(false, 'Unused TScalableFont.Render() was called');
-end;
-
-function TScalableFont.BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl;
-begin
- Result := fBaseFont.BBox(Text, Advance);
- Result.Left := Result.Left * fScale * fAspect;
- Result.Right := Result.Right * fScale * fAspect;
- Result.Top := Result.Top * fScale;
- Result.Bottom := Result.Bottom * fScale;
-end;
-
-procedure TScalableFont.SetHeight(Height: single);
-begin
- fScale := Height / fBaseFont.GetHeight();
-end;
-
-function TScalableFont.GetHeight(): single;
-begin
- Result := fBaseFont.GetHeight() * fScale;
-end;
-
-procedure TScalableFont.SetAspect(Aspect: single);
-begin
- fAspect := Aspect;
-end;
-
-function TScalableFont.GetAspect(): single;
-begin
- Result := fAspect;
-end;
-
-function TScalableFont.GetAscender(): single;
-begin
- Result := fBaseFont.GetAscender() * fScale;
-end;
-
-function TScalableFont.GetDescender(): single;
-begin
- Result := fBaseFont.GetDescender() * fScale;
-end;
-
-procedure TScalableFont.SetLineSpacing(Spacing: single);
-var
- Level: integer;
-begin
- for Level := 0 to High(fMipmapFonts) do
- if (fMipmapFonts[Level] <> nil) then
- fMipmapFonts[Level].SetLineSpacing(Spacing / GetMipmapScale(Level));
-end;
-
-function TScalableFont.GetLineSpacing(): single;
-begin
- Result := fBaseFont.GetLineSpacing() * fScale;
-end;
-
-procedure TScalableFont.SetGlyphSpacing(Spacing: single);
-var
- Level: integer;
-begin
- for Level := 0 to High(fMipmapFonts) do
- if (fMipmapFonts[Level] <> nil) then
- fMipmapFonts[Level].SetGlyphSpacing(Spacing / GetMipmapScale(Level));
-end;
-
-function TScalableFont.GetGlyphSpacing(): single;
-begin
- Result := fBaseFont.GetGlyphSpacing() * fScale;
-end;
-
-procedure TScalableFont.SetReflectionSpacing(Spacing: single);
-var
- Level: integer;
-begin
- for Level := 0 to High(fMipmapFonts) do
- if ((fMipmapFonts[Level] <> nil) AND (GetMipmapScale(Level) > 0)) then
- fMipmapFonts[Level].SetReflectionSpacing(Spacing / GetMipmapScale(Level));
-end;
-
-function TScalableFont.GetReflectionSpacing(): single;
-begin
- Result := fBaseFont.GetLineSpacing() * fScale;
-end;
-
-procedure TScalableFont.SetStyle(Style: TFontStyle);
-var
- Level: integer;
-begin
- for Level := 0 to High(fMipmapFonts) do
- if (fMipmapFonts[Level] <> nil) then
- fMipmapFonts[Level].SetStyle(Style);
-end;
-
-function TScalableFont.GetStyle(): TFontStyle;
-begin
- Result := fBaseFont.GetStyle();
-end;
-
-function TScalableFont.GetUnderlinePosition(): single;
-begin
- Result := fBaseFont.GetUnderlinePosition();
-end;
-
-function TScalableFont.GetUnderlineThickness(): single;
-begin
- Result := fBaseFont.GetUnderlinePosition();
-end;
-
-procedure TScalableFont.SetUseKerning(Enable: boolean);
-var
- Level: integer;
-begin
- for Level := 0 to High(fMipmapFonts) do
- if (fMipmapFonts[Level] <> nil) then
- fMipmapFonts[Level].SetUseKerning(Enable);
-end;
-
-
-{*
- * TCachedFont
- *}
-
-constructor TCachedFont.Create();
-begin
- inherited;
- fCache := TGlyphCache.Create();
-end;
-
-destructor TCachedFont.Destroy();
-begin
- fCache.Free;
- inherited;
-end;
-
-function TCachedFont.GetGlyph(ch: UCS4Char): TGlyph;
-begin
- Result := fCache.GetGlyph(ch);
- if (Result = nil) then
- begin
- Result := LoadGlyph(ch);
- if (not fCache.AddGlyph(ch, Result)) then
- Result.Free;
- end;
-end;
-
-procedure TCachedFont.FlushCache(KeepBaseSet: boolean);
-begin
- fCache.FlushCache(KeepBaseSet);
-end;
-
-
-{*
- * TFTFont
- *}
-
-constructor TFTFont.Create(
- const Filename: IPath;
- Size: integer; Outset: single;
- LoadFlags: FT_Int32);
-var
- ch: UCS4Char;
-begin
- inherited Create();
-
- fFilename := Filename;
- fSize := Size;
- fOutset := Outset;
- fLoadFlags := LoadFlags;
- fUseDisplayLists := true;
- fPart := fpNone;
-
- // load font information
- if (FT_New_Face(TFreeType.GetLibrary(), PChar(Filename.ToNative), 0, fFace) <> 0) then
- raise Exception.Create('FT_New_Face: Could not load font ''' + Filename.ToNative + '''');
-
- // support scalable fonts only
- if (not FT_IS_SCALABLE(fFace)) then
- raise Exception.Create('Font is not scalable');
-
- if (FT_Set_Pixel_Sizes(fFace, 0, Size) <> 0) then
- raise Exception.Create('FT_Set_Pixel_Sizes failes');
-
- // get scale factor for font-unit to pixel-size transformation
- fFontUnitScale.X := fFace.size.metrics.x_ppem / fFace.units_per_EM;
- fFontUnitScale.Y := fFace.size.metrics.y_ppem / fFace.units_per_EM;
-
- ResetIntern();
-
- // pre-cache some commonly used glyphs (' ' - '~')
- for ch := 32 to 126 do
- fCache.AddGlyph(ch, TFTGlyph.Create(Self, ch, Outset, LoadFlags));
-end;
-
-destructor TFTFont.Destroy();
-begin
- // free face
- FT_Done_Face(fFace);
- inherited;
-end;
-
-procedure TFTFont.ResetIntern();
-begin
- // Note: outset and non outset fonts use same spacing
- fLineSpacing := fFace.height * fFontUnitScale.Y;
- fReflectionSpacing := -2*fFace.descender * fFontUnitScale.Y;
-end;
-
-procedure TFTFont.Reset();
-begin
- inherited;
- ResetIntern();
-end;
-
-function TFTFont.LoadGlyph(ch: UCS4Char): TGlyph;
-begin
- Result := TFTGlyph.Create(Self, ch, Outset, fLoadFlags);
-end;
-
-function TFTFont.BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl;
-var
- Glyph, PrevGlyph: TFTGlyph;
- TextLine: UCS4String;
- LineYOffset: single;
- LineIndex, CharIndex: integer;
- LineBounds: TBoundsDbl;
- KernDelta: FT_Vector;
- UnderlinePos: double;
-begin
- // Reset global bounds
- Result.Left := Infinity;
- Result.Right := 0;
- Result.Bottom := Infinity;
- Result.Top := 0;
-
- // reset last glyph
- PrevGlyph := nil;
-
- // display text
- for LineIndex := 0 to High(Text) do
- begin
- // get next text line
- TextLine := Text[LineIndex];
- LineYOffset := -LineSpacing * LineIndex;
-
- // reset line bounds
- LineBounds.Left := Infinity;
- LineBounds.Right := 0;
- LineBounds.Bottom := Infinity;
- LineBounds.Top := 0;
-
- // for each glyph image, compute its bounding box
- for CharIndex := 0 to LengthUCS4(TextLine)-1 do
- begin
- Glyph := TFTGlyph(GetGlyph(TextLine[CharIndex]));
- if (Glyph <> nil) then
- begin
- // get kerning
- if (fUseKerning and FT_HAS_KERNING(fFace) and (PrevGlyph <> nil)) then
- begin
- FT_Get_Kerning(fFace, PrevGlyph.CharIndex, Glyph.CharIndex,
- FT_KERNING_UNSCALED, KernDelta);
- LineBounds.Right := LineBounds.Right + KernDelta.x * fFontUnitScale.X;
- end;
-
- // update left bound (must be done before right bound is updated)
- if (LineBounds.Right + Glyph.Bounds.Left < LineBounds.Left) then
- LineBounds.Left := LineBounds.Right + Glyph.Bounds.Left;
-
- // update right bound
- if (CharIndex < LengthUCS4(TextLine)-1) or // not the last character
- (TextLine[CharIndex] = Ord(' ')) or // on space char (Bounds.Right = 0)
- Advance then // or in advance mode
- begin
- // add advance and glyph spacing
- LineBounds.Right := LineBounds.Right + Glyph.Advance.x + GlyphSpacing
- end
- else
- begin
- // add glyph's right bound
- LineBounds.Right := LineBounds.Right + Glyph.Bounds.Right;
- end;
-
- // update bottom and top bounds
- if (Glyph.Bounds.Bottom < LineBounds.Bottom) then
- LineBounds.Bottom := Glyph.Bounds.Bottom;
- if (Glyph.Bounds.Top > LineBounds.Top) then
- LineBounds.Top := Glyph.Bounds.Top;
- end;
-
- PrevGlyph := Glyph;
- end;
-
- // handle italic font style
- if (Italic in Style) then
- begin
- LineBounds.Left := LineBounds.Left + LineBounds.Bottom * cShearFactor;
- LineBounds.Right := LineBounds.Right + LineBounds.Top * cShearFactor;
- end;
-
- // handle underlined font style
- if (Underline in Style) then
- begin
- UnderlinePos := GetUnderlinePosition();
- if (UnderlinePos < LineBounds.Bottom) then
- LineBounds.Bottom := UnderlinePos;
- end;
-
- // add line offset
- LineBounds.Bottom := LineBounds.Bottom + LineYOffset;
- LineBounds.Top := LineBounds.Top + LineYOffset;
-
- // adjust global bounds
- if (Result.Left > LineBounds.Left) then
- Result.Left := LineBounds.Left;
- if (Result.Right < LineBounds.Right) then
- Result.Right := LineBounds.Right;
- if (Result.Bottom > LineBounds.Bottom) then
- Result.Bottom := LineBounds.Bottom;
- if (Result.Top < LineBounds.Top) then
- Result.Top := LineBounds.Top;
- end;
-
- // if left or bottom bound was not set, set them to 0
- if (IsInfinite(Result.Left)) then
- Result.Left := 0.0;
- if (IsInfinite(Result.Bottom)) then
- Result.Bottom := 0.0;
-end;
-
-procedure TFTFont.Render(const Text: UCS4String);
-var
- CharIndex: integer;
- Glyph, PrevGlyph: TFTGlyph;
- KernDelta: FT_Vector;
-begin
- // reset last glyph
- PrevGlyph := nil;
-
- // draw current line
- for CharIndex := 0 to LengthUCS4(Text)-1 do
- begin
- Glyph := TFTGlyph(GetGlyph(Text[CharIndex]));
- if (Assigned(Glyph)) then
- begin
- // get kerning
- if (fUseKerning and FT_HAS_KERNING(fFace) and (PrevGlyph <> nil)) then
- begin
- FT_Get_Kerning(fFace, PrevGlyph.CharIndex, Glyph.CharIndex,
- FT_KERNING_UNSCALED, KernDelta);
- glTranslatef(KernDelta.x * fFontUnitScale.X, 0, 0);
- end;
-
- if (ReflectionPass) then
- Glyph.RenderReflection()
- else
- Glyph.Render(fUseDisplayLists);
-
- glTranslatef(Glyph.Advance.x + fGlyphSpacing, 0, 0);
- end;
-
- PrevGlyph := Glyph;
- end;
-end;
-
-function TFTFont.GetHeight(): single;
-begin
- Result := Ascender - Descender;
-end;
-
-function TFTFont.GetAscender(): single;
-begin
- Result := fFace.ascender * fFontUnitScale.Y + Outset*2;
-end;
-
-function TFTFont.GetDescender(): single;
-begin
- // Note: outset is not part of the descender as the baseline is lifted
- Result := fFace.descender * fFontUnitScale.Y;
-end;
-
-function TFTFont.GetUnderlinePosition(): single;
-begin
- Result := fFace.underline_position * fFontUnitScale.Y - Outset;
-end;
-
-function TFTFont.GetUnderlineThickness(): single;
-begin
- Result := fFace.underline_thickness * fFontUnitScale.Y + Outset*2;
-end;
-
-
-{*
- * TFTScalableFont
- *}
-
-constructor TFTScalableFont.Create(const Filename: IPath;
- Size: integer; OutsetAmount: single;
- UseMipmaps: boolean);
-var
- LoadFlags: FT_Int32;
-begin
- LoadFlags := FT_LOAD_DEFAULT;
- // Disable hinting and grid-fitting to preserve font outlines at each font
- // size, otherwise the font widths/heights do not match resulting in ugly
- // text size changes during zooming.
- // A drawback is a reduced quality with smaller font sizes but it is not that
- // bad with gray-scaled rendering (at least it looks better than OpenGL's
- // linear downscaling on minification).
- if (UseMipmaps) then
- LoadFlags := LoadFlags or FT_LOAD_NO_HINTING;
- inherited Create(
- TFTFont.Create(Filename, Size, Size * OutsetAmount, LoadFlags),
- UseMipmaps);
-end;
-
-function TFTScalableFont.CreateMipmap(Level: integer; Scale: single): TFont;
-var
- ScaledSize: integer;
- BaseFont: TFTFont;
-begin
- Result := nil;
- BaseFont := TFTFont(fBaseFont);
- ScaledSize := Round(BaseFont.Size * Scale);
- // do not create mipmap fonts < 8 pixels
- if (ScaledSize < 8) then
- Exit;
- Result := TFTFont.Create(BaseFont.fFilename,
- ScaledSize, BaseFont.fOutset * Scale,
- FT_LOAD_DEFAULT or FT_LOAD_NO_HINTING);
-end;
-
-function TFTScalableFont.GetOutset(): single;
-begin
- Result := TFTFont(fBaseFont).Outset * fScale;
-end;
-
-procedure TFTScalableFont.FlushCache(KeepBaseSet: boolean);
-var
- Level: integer;
-begin
- for Level := 0 to High(fMipmapFonts) do
- if (fMipmapFonts[Level] <> nil) then
- TFTFont(fMipmapFonts[Level]).FlushCache(KeepBaseSet);
-end;
-
-
-{*
- * TOutlineFont
- *}
-
-constructor TFTOutlineFont.Create(
- const Filename: IPath;
- Size: integer; Outset: single;
- LoadFlags: FT_Int32);
-begin
- inherited Create();
-
- fFilename := Filename;
- fSize := Size;
- fOutset := Outset;
-
- fInnerFont := TFTFont.Create(Filename, Size, 0.0, LoadFlags);
- fInnerFont.fPart := fpInner;
- fOutlineFont := TFTFont.Create(Filename, Size, Outset, LoadFlags);
- fOutlineFont.fPart := fpOutline;
-
- ResetIntern();
-end;
-
-destructor TFTOutlineFont.Destroy;
-begin
- fOutlineFont.Free;
- fInnerFont.Free;
- inherited;
-end;
-
-procedure TFTOutlineFont.ResetIntern();
-begin
- // TODO: maybe swap fInnerFont/fOutlineFont.GlyphSpacing to use the spacing
- // of the outline font?
- //fInnerFont.GlyphSpacing := fOutset*2;
- fOutlineFont.GlyphSpacing := -fOutset*2;
-
- fLineSpacing := fOutlineFont.LineSpacing;
- fReflectionSpacing := fOutlineFont.ReflectionSpacing;
- fOutlineColor := NewGLColor(0, 0, 0, -1);
-end;
-
-procedure TFTOutlineFont.Reset();
-begin
- inherited;
- fInnerFont.Reset();
- fOutlineFont.Reset();
- ResetIntern();
-end;
-
-procedure TFTOutlineFont.DrawUnderline(const Text: UCS4String);
-var
- CurrentColor: TGLColor;
- OutlineColor: TGLColor;
-begin
- // save current color
- glGetFloatv(GL_CURRENT_COLOR, @CurrentColor.vals);
-
- // if the outline's alpha component is < 0 use the current alpha
- OutlineColor := fOutlineColor;
- if (OutlineColor.a < 0) then
- OutlineColor.a := CurrentColor.a;
-
- // draw underline outline (in outline color)
- glColor4fv(@OutlineColor.vals);
- fOutlineFont.DrawUnderline(Text);
- glColor4fv(@CurrentColor.vals);
-
- // draw underline inner part (in current color)
- glPushMatrix();
- glTranslatef(fOutset, 0, 0);
- fInnerFont.DrawUnderline(Text);
- glPopMatrix();
-end;
-
-procedure TFTOutlineFont.Render(const Text: UCS4String);
-var
- CurrentColor: TGLColor;
- OutlineColor: TGLColor;
-begin
- // save current color
- glGetFloatv(GL_CURRENT_COLOR, @CurrentColor.vals);
-
- // if the outline's alpha component is < 0 use the current alpha
- OutlineColor := fOutlineColor;
- if (OutlineColor.a < 0) then
- OutlineColor.a := CurrentColor.a;
-
- { setup and render outline font }
-
- glColor4fv(@OutlineColor.vals);
- glPushMatrix();
- fOutlineFont.Render(Text);
- glPopMatrix();
- glColor4fv(@CurrentColor.vals);
-
- { setup and render inner font }
-
- glPushMatrix();
- glTranslatef(fOutset, fOutset, 0);
- fInnerFont.Render(Text);
- glPopMatrix();
-end;
-
-procedure TFTOutlineFont.SetOutlineColor(r, g, b: GLfloat; a: GLfloat);
-begin
- fOutlineColor := NewGLColor(r, g, b, a);
-end;
-
-procedure TFTOutlineFont.FlushCache(KeepBaseSet: boolean);
-begin
- fOutlineFont.FlushCache(KeepBaseSet);
- fInnerFont.FlushCache(KeepBaseSet);
-end;
-
-function TFTOutlineFont.BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl;
-begin
- Result := fOutlineFont.BBox(Text, Advance);
-end;
-
-function TFTOutlineFont.GetHeight(): single;
-begin
- Result := fOutlineFont.Height;
-end;
-
-function TFTOutlineFont.GetAscender(): single;
-begin
- Result := fOutlineFont.Ascender;
-end;
-
-function TFTOutlineFont.GetDescender(): single;
-begin
- Result := fOutlineFont.Descender;
-end;
-
-procedure TFTOutlineFont.SetLineSpacing(Spacing: single);
-begin
- inherited SetLineSpacing(Spacing);
- fInnerFont.LineSpacing := Spacing;
- fOutlineFont.LineSpacing := Spacing;
-end;
-
-procedure TFTOutlineFont.SetGlyphSpacing(Spacing: single);
-begin
- inherited SetGlyphSpacing(Spacing);
- fInnerFont.GlyphSpacing := Spacing;
- fOutlineFont.GlyphSpacing := Spacing - Outset*2;
-end;
-
-procedure TFTOutlineFont.SetReflectionSpacing(Spacing: single);
-begin
- inherited SetReflectionSpacing(Spacing);
- fInnerFont.ReflectionSpacing := Spacing;
- fOutlineFont.ReflectionSpacing := Spacing;
-end;
-
-procedure TFTOutlineFont.SetStyle(Style: TFontStyle);
-begin
- inherited SetStyle(Style);
- fInnerFont.Style := Style;
- fOutlineFont.Style := Style;
-end;
-
-function TFTOutlineFont.GetStyle(): TFontStyle;
-begin
- Result := inherited GetStyle();
-end;
-
-function TFTOutlineFont.GetUnderlinePosition(): single;
-begin
- Result := fOutlineFont.GetUnderlinePosition();
-end;
-
-function TFTOutlineFont.GetUnderlineThickness(): single;
-begin
- Result := fOutlineFont.GetUnderlinePosition();
-end;
-
-procedure TFTOutlineFont.SetUseKerning(Enable: boolean);
-begin
- inherited SetUseKerning(Enable);
- fInnerFont.fUseKerning := Enable;
- fOutlineFont.fUseKerning := Enable;
-end;
-
-procedure TFTOutlineFont.SetReflectionPass(Enable: boolean);
-begin
- inherited SetReflectionPass(Enable);
- fInnerFont.fReflectionPass := Enable;
- fOutlineFont.fReflectionPass := Enable;
-end;
-
-{**
- * TScalableOutlineFont
- *}
-
-constructor TFTScalableOutlineFont.Create(
- const Filename: IPath;
- Size: integer; OutsetAmount: single;
- UseMipmaps: boolean);
-var
- LoadFlags: FT_Int32;
-begin
- LoadFlags := FT_LOAD_DEFAULT;
- // Disable hinting and grid-fitting (see TFTScalableFont.Create)
- if (UseMipmaps) then
- LoadFlags := LoadFlags or FT_LOAD_NO_HINTING;
- inherited Create(
- TFTOutlineFont.Create(Filename, Size, Size*OutsetAmount, LoadFlags),
- UseMipmaps);
-end;
-
-function TFTScalableOutlineFont.CreateMipmap(Level: integer; Scale: single): TFont;
-var
- ScaledSize: integer;
- BaseFont: TFTOutlineFont;
-begin
- Result := nil;
- BaseFont := TFTOutlineFont(fBaseFont);
- ScaledSize := Round(BaseFont.Size*Scale);
- // do not create mipmap fonts < 8 pixels
- if (ScaledSize < 8) then
- Exit;
- Result := TFTOutlineFont.Create(BaseFont.fFilename,
- ScaledSize, BaseFont.fOutset*Scale,
- FT_LOAD_DEFAULT or FT_LOAD_NO_HINTING);
-end;
-
-function TFTScalableOutlineFont.GetOutset(): single;
-begin
- Result := TFTOutlineFont(fBaseFont).Outset * fScale;
-end;
-
-procedure TFTScalableOutlineFont.SetOutlineColor(r, g, b: GLfloat; a: GLfloat);
-var
- Level: integer;
-begin
- for Level := 0 to High(fMipmapFonts) do
- if (fMipmapFonts[Level] <> nil) then
- TFTOutlineFont(fMipmapFonts[Level]).SetOutlineColor(r, g, b, a);
-end;
-
-procedure TFTScalableOutlineFont.FlushCache(KeepBaseSet: boolean);
-var
- Level: integer;
-begin
- for Level := 0 to High(fMipmapFonts) do
- if (fMipmapFonts[Level] <> nil) then
- TFTOutlineFont(fMipmapFonts[Level]).FlushCache(KeepBaseSet);
-end;
-
-
-{*
- * TFTGlyph
- *}
-
-const
- {**
- * Size of the transparent border surrounding the glyph image in the texture.
- * The border is necessary because OpenGL does not smooth texels at the
- * border of a texture with the GL_CLAMP or GL_CLAMP_TO_EDGE styles.
- * Without the border, magnified glyph textures look very ugly at their edges.
- * It looks edgy, as if some pixels are missing especially on the left edge
- * (just set cTexSmoothBorder to 0 to see what is meant by this).
- * With the border even the glyphs edges are blended to the border (transparent)
- * color and everything looks nice.
- *
- * Note:
- * OpenGL already supports texture border by setting the border parameter
- * of glTexImage*D() to 1 and using a texture size of 2^m+2b and setting the
- * border pixels to the border color. In some forums it is discouraged to use
- * the border parameter as only a few of the more modern graphics cards support
- * this feature. On an ATI Radeon 9700 card, the slowed down to 0.5 fps and
- * the glyph's background got black. So instead of using this feature we
- * handle it on our own. The only drawback is that textures might get bigger
- * because the border might require a higher power of 2 size instead of just
- * two additional pixels.
- *}
- cTexSmoothBorder = 1;
-
-procedure TFTGlyph.StrokeBorder(var Glyph: FT_Glyph);
-var
- Outline: PFT_Outline;
- OuterStroker, InnerStroker: FT_Stroker;
- OuterNumPoints, InnerNumPoints, GlyphNumPoints: FT_UInt;
- OuterNumContours, InnerNumContours, GlyphNumContours: FT_UInt;
- OuterBorder, InnerBorder: FT_StrokerBorder;
- OutlineFlags: FT_Int;
- UseStencil: boolean;
-begin
- // It is possible to extrude the borders of a glyph with FT_Glyph_Stroke
- // but it will extrude the border to the outside and the inside of a glyph
- // although we just want to extrude to the outside.
- // FT_Glyph_StrokeBorder extrudes to the outside but also fills the interior
- // (this is what we need for bold fonts).
- // In both cases the inner font and outline font (border) will overlap.
- // Normally this does not matter but it does if alpha blending is active.
- // In this case if e.g. the inner color is set to white, the outline to red
- // and alpha to 0.5 the inner part will not be white it will be pink.
-
- InnerStroker := nil;
- OuterStroker := nil;
-
- // If we are to create the interior of an outlined font (fInner = true)
- // we have to create two borders:
- // - one extruded to the outside by fOutset pixels and
- // - one extruded to the inside by almost 0 zero pixels.
- // The second one is used as a stencil for the first one, clearing the
- // interiour of the glyph.
- // The stencil is not needed to create bold fonts.
- UseStencil := (fFont.fPart = fpInner);
-
- Outline := @FT_OutlineGlyph(Glyph).outline;
-
- OuterBorder := FT_Outline_GetOutsideBorder(Outline);
- if (OuterBorder = FT_STROKER_BORDER_LEFT) then
- InnerBorder := FT_STROKER_BORDER_RIGHT
- else
- InnerBorder := FT_STROKER_BORDER_LEFT;
-
- { extrude outer border }
-
- if (FT_Stroker_New(Glyph.library_, OuterStroker) <> 0) then
- raise Exception.Create('FT_Stroker_New failed!');
- FT_Stroker_Set(
- OuterStroker,
- Round(fOutset * 64),
- FT_STROKER_LINECAP_ROUND,
- FT_STROKER_LINEJOIN_BEVEL,
- 0);
-
- // similar to FT_Glyph_StrokeBorder(inner = FT_FALSE) but it is possible to
- // use FT_Stroker_ExportBorder() afterwards to combine inner and outer borders
- if (FT_Stroker_ParseOutline(OuterStroker, Outline, FT_FALSE) <> 0) then
- raise Exception.Create('FT_Stroker_ParseOutline failed!');
-
- FT_Stroker_GetBorderCounts(OuterStroker, OuterBorder, OuterNumPoints, OuterNumContours);
-
- { extrude inner border (= stencil) }
-
- if (UseStencil) then
- begin
- if (FT_Stroker_New(Glyph.library_, InnerStroker) <> 0) then
- raise Exception.Create('FT_Stroker_New failed!');
- FT_Stroker_Set(
- InnerStroker,
- 63, // extrude at most one pixel to avoid a black border
- FT_STROKER_LINECAP_ROUND,
- FT_STROKER_LINEJOIN_BEVEL,
- 0);
-
- if (FT_Stroker_ParseOutline(InnerStroker, Outline, FT_FALSE) <> 0) then
- raise Exception.Create('FT_Stroker_ParseOutline failed!');
-
- FT_Stroker_GetBorderCounts(InnerStroker, InnerBorder, InnerNumPoints, InnerNumContours);
- end else begin
- InnerNumPoints := 0;
- InnerNumContours := 0;
- end;
-
- { combine borders (subtract: OuterBorder - InnerBorder) }
-
- GlyphNumPoints := InnerNumPoints + OuterNumPoints;
- GlyphNumContours := InnerNumContours + OuterNumContours;
-
- // save flags before deletion (TODO: set them on the resulting outline)
- OutlineFlags := Outline.flags;
-
- // resize glyph outline to hold inner and outer border
- FT_Outline_Done(Glyph.Library_, Outline);
- if (FT_Outline_New(Glyph.Library_, GlyphNumPoints, GlyphNumContours, Outline) <> 0) then
- raise Exception.Create('FT_Outline_New failed!');
-
- Outline.n_points := 0;
- Outline.n_contours := 0;
-
- // add points to outline. The inner-border is used as a stencil.
- FT_Stroker_ExportBorder(OuterStroker, OuterBorder, Outline);
- if (UseStencil) then
- FT_Stroker_ExportBorder(InnerStroker, InnerBorder, Outline);
- if (FT_Outline_Check(outline) <> 0) then
- raise Exception.Create('FT_Stroker_ExportBorder failed!');
-
- if (InnerStroker <> nil) then
- FT_Stroker_Done(InnerStroker);
- if (OuterStroker <> nil) then
- FT_Stroker_Done(OuterStroker);
-end;
-
-procedure TFTGlyph.CreateTexture(LoadFlags: FT_Int32);
-var
- X, Y: integer;
- Glyph: FT_Glyph;
- BitmapGlyph: FT_BitmapGlyph;
- Bitmap: PFT_Bitmap;
- BitmapLine: PByteArray;
- BitmapBuffer: PByteArray;
- TexBuffer: TGLubyteDynArray;
- TexLine: PGLubyteArray;
- CBox: FT_BBox;
-begin
- // load the Glyph for our character
- if (FT_Load_Glyph(fFont.Face, fCharIndex, LoadFlags) <> 0) then
- raise Exception.Create('FT_Load_Glyph failed');
-
- // move the face's glyph into a Glyph object
- if (FT_Get_Glyph(fFont.Face^.glyph, Glyph) <> 0) then
- raise Exception.Create('FT_Get_Glyph failed');
-
- if (fOutset > 0) then
- StrokeBorder(Glyph);
-
- // store scaled advance width/height in glyph-object
- fAdvance.X := fFont.Face^.glyph^.advance.x / 64 + fOutset*2;
- fAdvance.Y := fFont.Face^.glyph^.advance.y / 64 + fOutset*2;
-
- // get the contour's bounding box (in 1/64th pixels, not font-units)
- FT_Glyph_Get_CBox(Glyph, FT_GLYPH_BBOX_UNSCALED, CBox);
- // convert 1/64th values to double values
- fBounds.Left := CBox.xMin / 64;
- fBounds.Right := CBox.xMax / 64 + fOutset*2;
- fBounds.Bottom := CBox.yMin / 64;
- fBounds.Top := CBox.yMax / 64 + fOutset*2;
-
- // convert the glyph to a bitmap (and destroy original glyph image).
- // Request 8 bit gray level pixel mode.
- FT_Glyph_To_Bitmap(Glyph, FT_RENDER_MODE_NORMAL, nil, 1);
- BitmapGlyph := FT_BitmapGlyph(Glyph);
-
- // get bitmap offsets
- fBitmapCoords.Left := BitmapGlyph^.left - cTexSmoothBorder;
- // Note: add 1*fOutset for lifting the baseline so outset fonts to not intersect
- // with the baseline; Ceil(fOutset) for the outset pixels added to the bitmap.
- fBitmapCoords.Top := BitmapGlyph^.top + fOutset+Ceil(fOutset) + cTexSmoothBorder;
-
- // make accessing the bitmap easier
- Bitmap := @BitmapGlyph^.bitmap;
- // get bitmap dimensions
- fBitmapCoords.Width := Bitmap.width + (Ceil(fOutset) + cTexSmoothBorder)*2;
- fBitmapCoords.Height := Bitmap.rows + (Ceil(fOutset) + cTexSmoothBorder)*2;
-
- // get power-of-2 bitmap widths
- fTexSize.Width :=
- NextPowerOf2(Bitmap.width + (Ceil(fOutset) + cTexSmoothBorder)*2);
- fTexSize.Height :=
- NextPowerOf2(Bitmap.rows + (Ceil(fOutset) + cTexSmoothBorder)*2);
-
- // texture-widths ignoring empty (power-of-2) padding space
- fTexOffset.X := fBitmapCoords.Width / fTexSize.Width;
- fTexOffset.Y := fBitmapCoords.Height / fTexSize.Height;
-
- // allocate memory for texture data
- SetLength(TexBuffer, fTexSize.Width * fTexSize.Height);
- FillChar(TexBuffer[0], Length(TexBuffer), 0);
-
- // Freetype stores the bitmap with either upper (pitch is > 0) or lower
- // (pitch < 0) glyphs line first. Set the buffer to the upper line.
- // See http://freetype.sourceforge.net/freetype2/docs/glyphs/glyphs-7.html
- if (Bitmap.pitch > 0) then
- BitmapBuffer := @Bitmap.buffer[0]
- else
- BitmapBuffer := @Bitmap.buffer[(Bitmap.rows-1) * Abs(Bitmap.pitch)];
-
- // copy data to texture bitmap (upper line first).
- for Y := 0 to Bitmap.rows-1 do
- begin
- // set pointer to first pixel in line that holds bitmap data.
- // Each line starts with a cTexSmoothBorder pixel and multiple outset pixels
- // that are added by Extrude() later.
- TexLine := @TexBuffer[(Y + cTexSmoothBorder + Ceil(fOutset)) * fTexSize.Width +
- cTexSmoothBorder + Ceil(fOutset)];
- // get next lower line offset, use pitch instead of width as it tells
- // us the storage direction of the lines. In addition a line might be padded.
- BitmapLine := @BitmapBuffer[Y * Bitmap.pitch];
-
- // check for pixel mode and copy pixels
- // Should be 8 bit gray, but even with FT_RENDER_MODE_NORMAL, freetype
- // sometimes (e.g. 16px sized japanese fonts) fallbacks to 1 bit pixels.
- case (Bitmap.pixel_mode) of
- FT_PIXEL_MODE_GRAY: begin // 8 bit gray
- for X := 0 to Bitmap.width-1 do
- TexLine[X] := BitmapLine[X];
- end;
- FT_PIXEL_MODE_MONO: begin // 1 bit mono
- for X := 0 to Bitmap.width-1 do
- TexLine[X] := High(GLubyte) * ((BitmapLine[X div 8] shr (7-(X mod 8))) and $1);
- end;
- else begin
- // unhandled pixel format
- end;
- end;
- end;
-
- // allocate resources for textures and display lists
- glGenTextures(1, @fTexture);
-
- // setup texture parameters
- glBindTexture(GL_TEXTURE_2D, fTexture);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
-
- glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
- // create alpha-map (GL_ALPHA component only).
- // TexCoord (0,0) corresponds to the top left pixel of the glyph,
- // (1,1) to the bottom right pixel. So the glyph is flipped as OpenGL uses
- // a cartesian (y-axis up) coordinate system for textures.
- // See the cTexSmoothBorder comment for info on texture borders.
- glTexImage2D(GL_TEXTURE_2D, 0, GL_ALPHA, fTexSize.Width, fTexSize.Height,
- 0, GL_ALPHA, GL_UNSIGNED_BYTE, @TexBuffer[0]);
-
- // free expanded data
- SetLength(TexBuffer, 0);
-
- // create the display list
- fDisplayList := glGenLists(1);
-
- // render to display-list
- glNewList(fDisplayList, GL_COMPILE);
- Render(false);
- glEndList();
-
- // free glyph data (bitmap, etc.)
- FT_Done_Glyph(Glyph);
-end;
-
-constructor TFTGlyph.Create(Font: TFTFont; ch: UCS4Char; Outset: single;
- LoadFlags: FT_Int32);
-begin
- inherited Create();
-
- fFont := Font;
- fOutset := Outset;
- fCharCode := ch;
-
- // get the Freetype char-index (use default UNICODE charmap)
- fCharIndex := FT_Get_Char_Index(Font.fFace, FT_ULONG(ch));
-
- CreateTexture(LoadFlags);
-end;
-
-destructor TFTGlyph.Destroy;
-begin
- if (fDisplayList <> 0) then
- glDeleteLists(fDisplayList, 1);
- if (fTexture <> 0) then
- glDeleteTextures(1, @fTexture);
- inherited;
-end;
-
-procedure TFTGlyph.Render(UseDisplayLists: boolean);
-begin
- // use display-lists if enabled and exit
- if (UseDisplayLists) then
- begin
- glCallList(fDisplayList);
- Exit;
- end;
-
- glBindTexture(GL_TEXTURE_2D, fTexture);
- glPushMatrix();
-
- // move to top left glyph position
- glTranslatef(fBitmapCoords.Left, fBitmapCoords.Top, 0);
-
- // draw glyph texture
- glBegin(GL_QUADS);
- // top right
- glTexCoord2f(fTexOffset.X, 0);
- glVertex2f(fBitmapCoords.Width, 0);
-
- // top left
- glTexCoord2f(0, 0);
- glVertex2f(0, 0);
-
- // bottom left
- glTexCoord2f(0, fTexOffset.Y);
- glVertex2f(0, -fBitmapCoords.Height);
-
- // bottom right
- glTexCoord2f(fTexOffset.X, fTexOffset.Y);
- glVertex2f(fBitmapCoords.Width, -fBitmapCoords.Height);
- glEnd();
-
- glPopMatrix();
-end;
-
-procedure TFTGlyph.RenderReflection();
-var
- Color: TGLColor;
- TexUpperPos: single;
- TexLowerPos: single;
- UpperPos: single;
-const
- CutOff = 0.6;
-begin
- glPushMatrix();
- glBindTexture(GL_TEXTURE_2D, fTexture);
- glGetFloatv(GL_CURRENT_COLOR, @Color.vals);
-
- // add extra space to the left of the glyph
- glTranslatef(fBitmapCoords.Left, 0, 0);
-
- // The upper position of the glyph, if CutOff is 1.0, it is fFont.Ascender.
- // If CutOff is set to 0.5 only half of the glyph height is displayed.
- UpperPos := fFont.Descender + fFont.Height * CutOff;
-
- // the glyph texture's height is just the height of the glyph but not the font
- // height. Setting a color for the upper and lower bounds of the glyph results
- // in different color gradients. So we have to set the color values for the
- // descender and ascender (as we have a cutoff, for the upper-pos here) as
- // these positions are font but not glyph specific.
-
- // To get the texture positions we have to enhance the texture at the top and
- // bottom by the amount from the top to ascender (rather upper-pos here) and
- // from the bottom (Height-Top) to descender. Then we have to convert those
- // heights to texture coordinates by dividing by the bitmap Height and
- // removing the power-of-2 padding space by multiplying with fTexOffset.Y
- // (as fBitmapCoords.Height corresponds to fTexOffset.Y and not 1.0).
- TexUpperPos := -(UpperPos - fBitmapCoords.Top) / fBitmapCoords.Height * fTexOffset.Y;
- TexLowerPos := (-(fFont.Descender + fBitmapCoords.Height - fBitmapCoords.Top) /
- fBitmapCoords.Height + 1) * fTexOffset.Y;
-
- // draw glyph texture
- glBegin(GL_QUADS);
- // top right
- glColor4f(Color.r, Color.g, Color.b, 0);
- glTexCoord2f(fTexOffset.X, TexUpperPos);
- glVertex2f(fBitmapCoords.Width, UpperPos);
-
- // top left
- glTexCoord2f(0, TexUpperPos);
- glVertex2f(0, UpperPos);
-
- // bottom left
- glColor4f(Color.r, Color.g, Color.b, Color.a-0.3);
- glTexCoord2f(0, TexLowerPos);
- glVertex2f(0, fFont.Descender);
-
- // bottom right
- glTexCoord2f(fTexOffset.X, TexLowerPos);
- glVertex2f(fBitmapCoords.Width, fFont.Descender);
- glEnd();
-
- glPopMatrix();
-
- // restore old color
- // Note: glPopAttrib(GL_CURRENT_BIT)/glPopAttrib() is much slower then
- // glGetFloatv(GL_CURRENT_COLOR, ...)/glColor4fv(...)
- glColor4fv(@Color.vals);
-end;
-
-function TFTGlyph.GetAdvance(): TPositionDbl;
-begin
- Result := fAdvance;
-end;
-
-function TFTGlyph.GetBounds(): TBoundsDbl;
-begin
- Result := fBounds;
-end;
-
-
-{*
- * TGlyphCache
- *}
-
-constructor TGlyphCache.Create();
-begin
- inherited;
- fHash := TList.Create();
-end;
-
-destructor TGlyphCache.Destroy();
-begin
- // free cached glyphs
- FlushCache(false);
-
- // destroy TList
- fHash.Free;
-
- inherited;
-end;
-
-function TGlyphCache.FindGlyphTable(BaseCode: cardinal; out InsertPos: integer): PGlyphTable;
-var
- I: integer;
- Entry: TGlyphCacheHashEntry;
-begin
- Result := nil;
-
- for I := 0 to fHash.Count-1 do
- begin
- Entry := TGlyphCacheHashEntry(fHash[I]);
-
- if (Entry.BaseCode > BaseCode) then
- begin
- InsertPos := I;
- Exit;
- end;
-
- if (Entry.BaseCode = BaseCode) then
- begin
- InsertPos := I;
- Result := @Entry.GlyphTable;
- Exit;
- end;
- end;
-
- InsertPos := fHash.Count;
-end;
-
-function TGlyphCache.AddGlyph(ch: UCS4Char; const Glyph: TGlyph): boolean;
-var
- BaseCode: cardinal;
- GlyphCode: integer;
- InsertPos: integer;
- GlyphTable: PGlyphTable;
- Entry: TGlyphCacheHashEntry;
-begin
- Result := false;
-
- BaseCode := Ord(ch) shr 8;
- GlyphTable := FindGlyphTable(BaseCode, InsertPos);
- if (GlyphTable = nil) then
- begin
- Entry := TGlyphCacheHashEntry.Create(BaseCode);
- GlyphTable := @Entry.GlyphTable;
- fHash.Insert(InsertPos, Entry);
- end;
-
- // get glyph table offset
- GlyphCode := Ord(ch) and $FF;
- // insert glyph into table if not present
- if (GlyphTable[GlyphCode] = nil) then
- begin
- GlyphTable[GlyphCode] := Glyph;
- Result := true;
- end;
-end;
-
-procedure TGlyphCache.DeleteGlyph(ch: UCS4Char);
-var
- Table: PGlyphTable;
- TableIndex, GlyphIndex: integer;
- TableEmpty: boolean;
-begin
- // find table
- Table := FindGlyphTable(Ord(ch) shr 8, TableIndex);
- if (Table = nil) then
- Exit;
-
- // find glyph
- GlyphIndex := Ord(ch) and $FF;
- if (Table[GlyphIndex] <> nil) then
- begin
- // destroy glyph
- FreeAndNil(Table[GlyphIndex]);
-
- // check if table is empty
- TableEmpty := true;
- for GlyphIndex := 0 to High(Table^) do
- begin
- if (Table[GlyphIndex] <> nil) then
- begin
- TableEmpty := false;
- Break;
- end;
- end;
-
- // free empty table
- if (TableEmpty) then
- begin
- fHash.Delete(TableIndex);
- end;
- end;
-end;
-
-function TGlyphCache.GetGlyph(ch: UCS4Char): TGlyph;
-var
- InsertPos: integer;
- Table: PGlyphTable;
-begin
- Table := FindGlyphTable(Ord(ch) shr 8, InsertPos);
- if (Table = nil) then
- Result := nil
- else
- Result := Table[Ord(ch) and $FF];
-end;
-
-function TGlyphCache.HasGlyph(ch: UCS4Char): boolean;
-begin
- Result := (GetGlyph(ch) <> nil);
-end;
-
-procedure TGlyphCache.FlushCache(KeepBaseSet: boolean);
-var
- EntryIndex, TableIndex: integer;
- Entry: TGlyphCacheHashEntry;
-begin
- // destroy cached glyphs
- for EntryIndex := 0 to fHash.Count-1 do
- begin
- Entry := TGlyphCacheHashEntry(fHash[EntryIndex]);
-
- // the base set (0-255) has BaseCode 0 as the upper bytes are 0.
- if KeepBaseSet and (Entry.fBaseCode = 0) then
- Continue;
-
- for TableIndex := 0 to High(Entry.GlyphTable) do
- begin
- if (Entry.GlyphTable[TableIndex] <> nil) then
- FreeAndNil(Entry.GlyphTable[TableIndex]);
- end;
- FreeAndNil(Entry);
- end;
-end;
-
-
-{*
- * TGlyphCacheEntry
- *}
-
-constructor TGlyphCacheHashEntry.Create(BaseCode: cardinal);
-begin
- inherited Create();
- fBaseCode := BaseCode;
-end;
-
-
-{*
- * TFreeType
- *}
-
-class function TFreeType.GetLibrary(): FT_Library;
-begin
- if (LibraryInst = nil) then
- begin
- // initialize freetype
- if (FT_Init_FreeType(LibraryInst) <> 0) then
- raise Exception.Create('FT_Init_FreeType failed');
- end;
- Result := LibraryInst;
-end;
-
-class procedure TFreeType.FreeLibrary();
-begin
- if (LibraryInst <> nil) then
- FT_Done_FreeType(LibraryInst);
- LibraryInst := nil;
-end;
-
-
-{$IFDEF BITMAP_FONT}
-{*
- * TBitmapFont
- *}
-
-constructor TBitmapFont.Create(const Filename: IPath; Outline: integer;
- Baseline, Ascender, Descender: integer);
-begin
- inherited Create();
-
- fTex := Texture.LoadTexture(true, Filename, TEXTURE_TYPE_TRANSPARENT, 0);
- fTexSize := 1024;
- fOutline := Outline;
- fBaseline := Baseline;
- fAscender := Ascender;
- fDescender := Descender;
-
- LoadFontInfo(Filename.SetExtension('.dat'));
-
- ResetIntern();
-end;
-
-destructor TBitmapFont.Destroy();
-begin
- glDeleteTextures(1, @fTex.TexNum);
- inherited;
-end;
-
-procedure TBitmapFont.ResetIntern();
-begin
- fLineSpacing := Height;
-end;
-
-procedure TBitmapFont.Reset();
-begin
- inherited;
- ResetIntern();
-end;
-
-procedure TBitmapFont.CorrectWidths(WidthMult: real; WidthAdd: integer);
-var
- Count: integer;
-begin
- for Count := 0 to 255 do
- fWidths[Count] := Round(fWidths[Count] * WidthMult) + WidthAdd;
-end;
-
-procedure TBitmapFont.LoadFontInfo(const InfoFile: IPath);
-var
- Stream: TStream;
-begin
- FillChar(fWidths[0], Length(fWidths), 0);
-
- Stream := nil;
- try
- Stream := TBinaryFileStream.Create(InfoFile, fmOpenRead);
- Stream.Read(fWidths, 256);
- except
- raise Exception.Create('Could not read font info file ''' + InfoFile.ToNative + '''');
- end;
- Stream.Free;
-end;
-
-function TBitmapFont.BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl;
-var
- LineIndex, CharIndex: integer;
- CharCode: cardinal;
- Line: UCS4String;
- LineWidth: double;
-begin
- Result.Left := 0;
- Result.Right := 0;
- Result.Top := Height;
- Result.Bottom := 0;
-
- for LineIndex := 0 to High(Text) do
- begin
- Line := Text[LineIndex];
- LineWidth := 0;
- for CharIndex := 0 to LengthUCS4(Line)-1 do
- begin
- CharCode := Ord(Line[CharIndex]);
- if (CharCode < Length(fWidths)) then
- LineWidth := LineWidth + fWidths[CharCode];
- end;
- if (LineWidth > Result.Right) then
- Result.Right := LineWidth;
- end;
-end;
-
-procedure TBitmapFont.RenderChar(ch: UCS4Char; var AdvanceX: real);
-var
- TexX, TexY: real;
- TexR, TexB: real;
- GlyphWidth: real;
- PL, PT: real;
- PR, PB: real;
- CharCode: cardinal;
-begin
- CharCode := Ord(ch);
- if (CharCode > High(fWidths)) then
- CharCode := 0;
-
- GlyphWidth := fWidths[CharCode];
-
- // set texture positions
- TexX := (CharCode mod 16) * 1/16 + 1/32 - (GlyphWidth/2 - fOutline)/fTexSize;
- TexY := (CharCode div 16) * 1/16 + {2 texels} 2/fTexSize;
- TexR := (CharCode mod 16) * 1/16 + 1/32 + (GlyphWidth/2 + fOutline)/fTexSize;
- TexB := (1 + CharCode div 16) * 1/16 - {2 texels} 2/fTexSize;
-
- // set vector positions
- PL := AdvanceX - fOutline;
- PR := PL + GlyphWidth + fOutline*2;
- PB := -fBaseline;
- PT := PB + fTexSize div 16;
-
- (*
- if (Font.Blend) then
- begin
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- end;
- *)
-
- glEnable(GL_TEXTURE_2D);
- glBindTexture(GL_TEXTURE_2D, fTex.TexNum);
-
- if (not ReflectionPass) then
- begin
- glBegin(GL_QUADS);
- glTexCoord2f(TexX, TexY); glVertex2f(PL, PT);
- glTexCoord2f(TexX, TexB); glVertex2f(PL, PB);
- glTexCoord2f(TexR, TexB); glVertex2f(PR, PB);
- glTexCoord2f(TexR, TexY); glVertex2f(PR, PT);
- glEnd;
- end
- else
- begin
- glDepthRange(0, 10);
- glDepthFunc(GL_LEQUAL);
- glEnable(GL_DEPTH_TEST);
-
- glBegin(GL_QUADS);
- glTexCoord2f(TexX, TexY); glVertex2f(PL, PT);
- glTexCoord2f(TexX, TexB); glVertex2f(PL, PB);
- glTexCoord2f(TexR, TexB); glVertex2f(PR, PB);
- glTexCoord2f(TexR, TexY); glVertex2f(PR, PT);
- glEnd;
-
- glBegin(GL_QUADS);
- glTexCoord2f(TexX, TexY); glVertex2f(PL, PT);
- glTexCoord2f(TexX, TexB); glVertex2f(PL, PB);
- glTexCoord2f(TexR, TexB); glVertex2f(PR, PB);
- glTexCoord2f(TexR, TexY); glVertex2f(PR, PT);
-
-(*
- glColor4f(fTempColor.r, fTempColor.g, fTempColor.b, 0.7);
- glTexCoord2f(TexX, TexB); glVertex3f(PL, PB, 0);
- glTexCoord2f(TexR, TexB); glVertex3f(PR, PB, 0);
-
- glColor4f(fTempColor.r, fTempColor.g, fTempColor.b, 0);
- glTexCoord2f(TexR, (TexY + TexB)/2); glVertex3f(PR, (PT + PB)/2, 0);
- glTexCoord2f(TexX, (TexY + TexB)/2); glVertex3f(PL, (PT + PB)/2, 0);
-*)
- glEnd;
-
- //write the colour back
- glColor4fv(@fTempColor);
-
- glDisable(GL_DEPTH_TEST);
- end; // reflection
-
- glDisable(GL_TEXTURE_2D);
- (*
- if (Font.Blend) then
- glDisable(GL_BLEND);
- *)
-
- AdvanceX := AdvanceX + GlyphWidth;
-end;
-
-procedure TBitmapFont.Render(const Text: UCS4String);
-var
- CharIndex: integer;
- AdvanceX: real;
-begin
- // if there is no text do nothing
- if (Text = nil) or (Text[0] = 0) then
- Exit;
-
- //Save the current color and alpha (for reflection)
- glGetFloatv(GL_CURRENT_COLOR, @fTempColor);
-
- AdvanceX := 0;
- for CharIndex := 0 to LengthUCS4(Text)-1 do
- begin
- RenderChar(Text[CharIndex], AdvanceX);
- end;
-end;
-
-function TBitmapFont.GetHeight(): single;
-begin
- Result := fAscender - fDescender;
-end;
-
-function TBitmapFont.GetAscender(): single;
-begin
- Result := fAscender;
-end;
-
-function TBitmapFont.GetDescender(): single;
-begin
- Result := fDescender;
-end;
-
-function TBitmapFont.GetUnderlinePosition(): single;
-begin
- Result := -2.0;
-end;
-
-function TBitmapFont.GetUnderlineThickness(): single;
-begin
- Result := 1.0;
-end;
-
-{$ENDIF BITMAP_FONT}
-
-
-initialization
-
-finalization
- TFreeType.FreeLibrary();
-
-end.
diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas
deleted file mode 100644
index b0e5a7d8..00000000
--- a/src/base/UGraphic.pas
+++ /dev/null
@@ -1,823 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UGraphic;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- SDL,
- gl,
- glext,
- UTexture,
- TextGL,
- ULog,
- SysUtils,
- ULyrics,
- UImage,
- UMusic,
- UScreenLoading,
- UScreenWelcome,
- UScreenMain,
- UScreenName,
- UScreenLevel,
- UScreenOptions,
- UScreenOptionsGame,
- UScreenOptionsGraphics,
- UScreenOptionsSound,
- UScreenOptionsLyrics,
- UScreenOptionsThemes,
- UScreenOptionsRecord,
- UScreenOptionsAdvanced,
- UScreenSong,
- UScreenSing,
- UScreenScore,
- UScreenTop5,
- UScreenEditSub,
- UScreenEdit,
- UScreenEditConvert,
- UScreenEditHeader,
- UScreenOpen,
- UThemes,
- USkins,
- UScreenSongMenu,
- UScreenSongJumpto,
- {Party Screens}
- UScreenSingModi,
- UScreenPartyNewRound,
- UScreenPartyScore,
- UScreenPartyOptions,
- UScreenPartyWin,
- UScreenPartyPlayer,
- {Stats Screens}
- UScreenStatMain,
- UScreenStatDetail,
- {CreditsScreen}
- UScreenCredits,
- {Popup for errors, etc.}
- UScreenPopup;
-
-type
- TRecR = record
- Top: real;
- Left: real;
- Right: real;
- Bottom: real;
- end;
-
-var
- Screen: PSDL_Surface;
- LoadingThread: PSDL_Thread;
- Mutex: PSDL_Mutex;
-
- RenderW: integer;
- RenderH: integer;
- ScreenW: integer;
- ScreenH: integer;
- Screens: integer;
- ScreenAct: integer;
- ScreenX: integer;
-
- ScreenLoading: TScreenLoading;
- ScreenWelcome: TScreenWelcome;
- ScreenMain: TScreenMain;
- ScreenName: TScreenName;
- ScreenLevel: TScreenLevel;
- ScreenSong: TScreenSong;
- ScreenSing: TScreenSing;
- ScreenScore: TScreenScore;
- ScreenTop5: TScreenTop5;
- ScreenOptions: TScreenOptions;
- ScreenOptionsGame: TScreenOptionsGame;
- ScreenOptionsGraphics: TScreenOptionsGraphics;
- ScreenOptionsSound: TScreenOptionsSound;
- ScreenOptionsLyrics: TScreenOptionsLyrics;
- ScreenOptionsThemes: TScreenOptionsThemes;
- ScreenOptionsRecord: TScreenOptionsRecord;
- ScreenOptionsAdvanced: TScreenOptionsAdvanced;
- ScreenEditSub: TScreenEditSub;
- ScreenEdit: TScreenEdit;
- ScreenEditConvert: TScreenEditConvert;
- ScreenEditHeader: TScreenEditHeader;
- ScreenOpen: TScreenOpen;
-
- ScreenSongMenu: TScreenSongMenu;
- ScreenSongJumpto: TScreenSongJumpto;
-
- //Party Screens
- ScreenSingModi: TScreenSingModi;
- ScreenPartyNewRound: TScreenPartyNewRound;
- ScreenPartyScore: TScreenPartyScore;
- ScreenPartyWin: TScreenPartyWin;
- ScreenPartyOptions: TScreenPartyOptions;
- ScreenPartyPlayer: TScreenPartyPlayer;
-
- //StatsScreens
- ScreenStatMain: TScreenStatMain;
- ScreenStatDetail: TScreenStatDetail;
-
- //CreditsScreen
- ScreenCredits: TScreenCredits;
-
- //popup mod
- ScreenPopupCheck: TScreenPopupCheck;
- ScreenPopupError: TScreenPopupError;
- ScreenPopupInfo: TScreenPopupInfo;
-
- //Notes
- Tex_Left: array[1..6] of TTexture; //rename to tex_note_left
- Tex_Mid: array[1..6] of TTexture; //rename to tex_note_mid
- Tex_Right: array[1..6] of TTexture; //rename to tex_note_right
-
- Tex_plain_Left: array[1..6] of TTexture; //rename to tex_notebg_left
- Tex_plain_Mid: array[1..6] of TTexture; //rename to tex_notebg_mid
- Tex_plain_Right: array[1..6] of TTexture; //rename to tex_notebg_right
-
- Tex_BG_Left: array[1..6] of TTexture; //rename to tex_noteglow_left
- Tex_BG_Mid: array[1..6] of TTexture; //rename to tex_noteglow_mid
- Tex_BG_Right: array[1..6] of TTexture; //rename to tex_noteglow_right
-
- Tex_Note_Star: TTexture;
- Tex_Note_Perfect_Star: TTexture;
-
-
- Tex_Ball: TTexture;
- Tex_Lyric_Help_Bar: TTexture;
- FullScreen: boolean;
-
- Tex_TimeProgress: TTexture;
-
- //Sing Bar Mod
- Tex_SingBar_Back: TTexture;
- Tex_SingBar_Bar: TTexture;
- Tex_SingBar_Front: TTexture;
- //end Singbar Mod
-
- //PhrasenBonus - Line Bonus Mod
- Tex_SingLineBonusBack: array[0..8] of TTexture;
- //End PhrasenBonus - Line Bonus Mod
-
- //ScoreBG Texs
- Tex_ScoreBG: array [0..5] of TTexture;
-
- //Score Screen Textures
- Tex_Score_NoteBarLevel_Dark : array [1..6] of TTexture;
- Tex_Score_NoteBarRound_Dark : array [1..6] of TTexture;
-
- Tex_Score_NoteBarLevel_Light : array [1..6] of TTexture;
- Tex_Score_NoteBarRound_Light : array [1..6] of TTexture;
-
- Tex_Score_NoteBarLevel_Lightest : array [1..6] of TTexture;
- Tex_Score_NoteBarRound_Lightest : array [1..6] of TTexture;
-
- Tex_Score_Ratings : array [0..7] of TTexture;
-
- // arrows for SelectSlide
- Tex_SelectS_ArrowL: TTexture;
- Tex_SelectS_ArrowR: TTexture;
-
- // textures for software mouse cursor
- Tex_Cursor_Unpressed: TTexture;
- Tex_Cursor_Pressed: TTexture;
-const
- Skin_BGColorR = 1;
- Skin_BGColorG = 1;
- Skin_BGColorB = 1;
-
- Skin_SpectrumR = 0;
- Skin_SpectrumG = 0;
- Skin_SpectrumB = 0;
-
- Skin_Spectograph1R = 0.6;
- Skin_Spectograph1G = 0.8;
- Skin_Spectograph1B = 1;
-
- Skin_Spectograph2R = 0;
- Skin_Spectograph2G = 0;
- Skin_Spectograph2B = 0.2;
-
- Skin_FontR = 0;
- Skin_FontG = 0;
- Skin_FontB = 0;
-
- Skin_FontHighlightR = 0.3; // 0.3
- Skin_FontHighlightG = 0.3; // 0.3
- Skin_FontHighlightB = 1; // 1
-
- Skin_TimeR = 0.25; //0,0,0
- Skin_TimeG = 0.25;
- Skin_TimeB = 0.25;
-
- Skin_OscR = 0;
- Skin_OscG = 0;
- Skin_OscB = 0;
-
- Skin_SpectrumT = 470;
- Skin_SpectrumBot = 570;
- Skin_SpectrumH = 100;
-
- Skin_P1_LinesR = 0.5; // 0.6 0.6 1
- Skin_P1_LinesG = 0.5;
- Skin_P1_LinesB = 0.5;
-
- Skin_P2_LinesR = 0.5; // 1 0.6 0.6
- Skin_P2_LinesG = 0.5;
- Skin_P2_LinesB = 0.5;
-
- Skin_P1_NotesB = 250;
- Skin_P2_NotesB = 430; // 430 / 300
-
- Skin_P1_ScoreT = 50;
- Skin_P1_ScoreL = 20;
-
- Skin_P2_ScoreT = 50;
- Skin_P2_ScoreL = 640;
-
-procedure Initialize3D (Title: string);
-procedure Reinitialize3D;
-procedure SwapBuffers;
-
-procedure LoadTextures;
-procedure InitializeScreen;
-procedure LoadLoadingScreen;
-procedure LoadScreens;
-procedure UnLoadScreens;
-
-function LoadingThreadFunction: integer;
-
-
-implementation
-
-uses
- Classes,
- UMain,
- UIni,
- UDisplay,
- UCommandLine,
- UPathUtils;
-
-procedure LoadFontTextures;
-begin
- Log.LogStatus('Building Fonts', 'LoadTextures');
- BuildFont;
-end;
-
-procedure LoadTextures;
-
-var
- P: integer;
- R, G, B: real;
- Col: integer;
-begin
- Log.LogStatus('Loading Textures', 'LoadTextures');
-
- // P1-6
- // TODO... do it once for each player... this is a bit crappy !!
- // can we make it any better !?
- for P := 1 to 6 do
- begin
- LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light');
- Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
-
- { some colors for tests
- Col := $10000 * Round(0.02*255) + $100 * Round(0.6 *255) + Round(0.8 *255); //blue
- Col := $10000 * Round(0.8 *255) ; //red
- Col := $100 * Round(0.85*255) ; //green
- Col := $10000 * 255 + $100 * Round(0.52*255) ; //orange
- Col := $10000 * 255 + $100 * 255 ; //yellow
- Col := $10000 * Round(0.82*255) + 255 ; //purple
- Col := $10000 * Round(0.22*255) + $100 * Round(0.39*255) + Round(0.64*255); //dark blue
- Col := $10000 * Round(0 *255) + $100 * Round(0 *255) + Round(0 *255); //black
- Col := $10000 * Round(1.0 *255) + $100 * Round(0.43*255) + Round(0.70*255); //pink
- Col := 0; //black
- Col := $FFFFFF; //white
- Col := $FF0000; //red
- Col := $00FF00; //green
- Col := $002200; //light green
- Col := $002222; //light greenblue
- Col := $222200; //light yellow
- Col := $340000; //red
- Col := $FF6EB4; //pink
- Col := $333333; //grey
- }
-
- Tex_Left[P] := Texture.LoadTexture(Skin.GetTextureFileName('GrayLeft'), TEXTURE_TYPE_COLORIZED, Col);
- Tex_Mid[P] := Texture.LoadTexture(Skin.GetTextureFileName('GrayMid'), TEXTURE_TYPE_COLORIZED, Col);
- Tex_Right[P] := Texture.LoadTexture(Skin.GetTextureFileName('GrayRight'), TEXTURE_TYPE_COLORIZED, Col);
-
- Tex_plain_Left[P] := Texture.LoadTexture(Skin.GetTextureFileName('NotePlainLeft'), TEXTURE_TYPE_COLORIZED, Col);
- Tex_plain_Mid[P] := Texture.LoadTexture(Skin.GetTextureFileName('NotePlainMid'), TEXTURE_TYPE_COLORIZED, Col);
- Tex_plain_Right[P] := Texture.LoadTexture(Skin.GetTextureFileName('NotePlainRight'), TEXTURE_TYPE_COLORIZED, Col);
-
- Tex_BG_Left[P] := Texture.LoadTexture(Skin.GetTextureFileName('NoteBGLeft'), TEXTURE_TYPE_COLORIZED, Col);
- Tex_BG_Mid[P] := Texture.LoadTexture(Skin.GetTextureFileName('NoteBGMid'), TEXTURE_TYPE_COLORIZED, Col);
- Tex_BG_Right[P] := Texture.LoadTexture(Skin.GetTextureFileName('NoteBGRight'), TEXTURE_TYPE_COLORIZED, Col);
- end;
-
- Log.LogStatus('Loading Textures - B', 'LoadTextures');
-
- Tex_Note_Perfect_Star := Texture.LoadTexture(Skin.GetTextureFileName('NotePerfectStar'), TEXTURE_TYPE_TRANSPARENT, 0);
- Tex_Note_Star := Texture.LoadTexture(Skin.GetTextureFileName('NoteStar') , TEXTURE_TYPE_TRANSPARENT, $FFFFFF);
- Tex_Ball := Texture.LoadTexture(Skin.GetTextureFileName('Ball'), TEXTURE_TYPE_TRANSPARENT, $FF00FF);
- Tex_Lyric_Help_Bar := Texture.LoadTexture(Skin.GetTextureFileName('LyricHelpBar'), TEXTURE_TYPE_TRANSPARENT, $FF00FF);
-
- Tex_SelectS_ArrowL := Texture.LoadTexture(Skin.GetTextureFileName('Select_ArrowLeft'), TEXTURE_TYPE_TRANSPARENT, 0);
- Tex_SelectS_ArrowR := Texture.LoadTexture(Skin.GetTextureFileName('Select_ArrowRight'), TEXTURE_TYPE_TRANSPARENT, 0);
-
- Tex_Cursor_Unpressed := Texture.LoadTexture(Skin.GetTextureFileName('Cursor'), TEXTURE_TYPE_TRANSPARENT, 0);
-
- if (Skin.GetTextureFileName('Cursor_Pressed').IsSet) then
- Tex_Cursor_Pressed := Texture.LoadTexture(Skin.GetTextureFileName('Cursor_Pressed'), TEXTURE_TYPE_TRANSPARENT, 0)
- else
- Tex_Cursor_Pressed.TexNum := 0;
-
- //TimeBar mod
- Tex_TimeProgress := Texture.LoadTexture(Skin.GetTextureFileName('TimeBar'));
- //eoa TimeBar mod
-
- //SingBar Mod
- Tex_SingBar_Back := Texture.LoadTexture(Skin.GetTextureFileName('SingBarBack'), TEXTURE_TYPE_PLAIN, 0);
- Tex_SingBar_Bar := Texture.LoadTexture(Skin.GetTextureFileName('SingBarBar'), TEXTURE_TYPE_PLAIN, 0);
- Tex_SingBar_Front := Texture.LoadTexture(Skin.GetTextureFileName('SingBarFront'), TEXTURE_TYPE_PLAIN, 0);
- //end Singbar Mod
-
- Log.LogStatus('Loading Textures - C', 'LoadTextures');
-
- //Line Bonus PopUp
- for P := 0 to 8 do
- begin
- Case P of
- 0: begin
- R := 1;
- G := 0;
- B := 0;
- end;
- 1..3: begin
- R := 1;
- G := (P * 0.25);
- B := 0;
- end;
- 4: begin
- R := 1;
- G := 1;
- B := 0;
- end;
- 5..7: begin
- R := 1-((P-4)*0.25);
- G := 1;
- B := 0;
- end;
- 8: begin
- R := 0;
- G := 1;
- B := 0;
- end;
- End;
-
- Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
- Tex_SingLineBonusBack[P] := Texture.LoadTexture(Skin.GetTextureFileName('LineBonusBack'), TEXTURE_TYPE_COLORIZED, Col);
- end;
-
-//## backgrounds for the scores ##
- for P := 0 to 5 do begin
- LoadColor(R, G, B, 'P' + IntToStr(P+1) + 'Light');
- Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
- Tex_ScoreBG[P] := Texture.LoadTexture(Skin.GetTextureFileName('ScoreBG'), TEXTURE_TYPE_COLORIZED, Col);
- end;
-
-
- Log.LogStatus('Loading Textures - D', 'LoadTextures');
-
-// ######################
-// Score screen textures
-// ######################
-
-//## the bars that visualize the score ##
- for P := 1 to 6 do begin
-//NoteBar ScoreBar
- LoadColor(R, G, B, 'P' + IntToStr(P) + 'Dark');
- Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
- Tex_Score_NoteBarLevel_Dark[P] := Texture.LoadTexture(Skin.GetTextureFileName('ScoreLevel_Dark'), TEXTURE_TYPE_COLORIZED, Col);
- Tex_Score_NoteBarRound_Dark[P] := Texture.LoadTexture(Skin.GetTextureFileName('ScoreLevel_Dark_Round'), TEXTURE_TYPE_COLORIZED, Col);
-//LineBonus ScoreBar
- LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light');
- Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
- Tex_Score_NoteBarLevel_Light[P] := Texture.LoadTexture(Skin.GetTextureFileName('ScoreLevel_Light'), TEXTURE_TYPE_COLORIZED, Col);
- Tex_Score_NoteBarRound_Light[P] := Texture.LoadTexture(Skin.GetTextureFileName('ScoreLevel_Light_Round'), TEXTURE_TYPE_COLORIZED, Col);
-//GoldenNotes ScoreBar
- LoadColor(R, G, B, 'P' + IntToStr(P) + 'Lightest');
- Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
- Tex_Score_NoteBarLevel_Lightest[P] := Texture.LoadTexture(Skin.GetTextureFileName('ScoreLevel_Lightest'), TEXTURE_TYPE_COLORIZED, Col);
- Tex_Score_NoteBarRound_Lightest[P] := Texture.LoadTexture(Skin.GetTextureFileName('ScoreLevel_Lightest_Round'), TEXTURE_TYPE_COLORIZED, Col);
- end;
-
-//## rating pictures that show a picture according to your rate ##
- for P := 0 to 7 do begin
- Tex_Score_Ratings[P] := Texture.LoadTexture(Skin.GetTextureFileName('Rating_'+IntToStr(P)), TEXTURE_TYPE_TRANSPARENT, 0);
- end;
-
- Log.LogStatus('Loading Textures - Done', 'LoadTextures');
-end;
-
-(*
- * Load OpenGL extensions. Must be called after SDL_SetVideoMode() and each
- * time the pixel-format or render-context (RC) changes.
- *)
-procedure LoadOpenGLExtensions;
-begin
- // Load OpenGL 1.2 extensions for OpenGL 1.2 compatibility
- if (not Load_GL_version_1_2()) then
- begin
- Log.LogCritical('Failed loading OpenGL 1.2', 'UGraphic.Initialize3D');
- end;
-
- // Other extensions e.g. OpenGL 1.3-2.0 or Framebuffer-Object might be loaded here
- // ...
- //Load_GL_EXT_framebuffer_object();
-end;
-
-const
- WINDOW_ICON = 'icons/ultrastardx-icon.png';
-
-procedure Initialize3D (Title: string);
-var
- Icon: PSDL_Surface;
-begin
- Log.LogStatus('SDL_Init', 'UGraphic.Initialize3D');
- if ( SDL_InitSubSystem(SDL_INIT_VIDEO) = -1 ) then
- begin
- Log.LogCritical('SDL_Init Failed', 'UGraphic.Initialize3D');
- end;
-
- // load icon image (must be 32x32 for win32)
- Icon := LoadImage(ResourcesPath.Append(WINDOW_ICON));
- if (Icon <> nil) then
- SDL_WM_SetIcon(Icon, nil);
-
- SDL_WM_SetCaption(PChar(Title), nil);
-
- //Log.BenchmarkStart(2);
-
- InitializeScreen;
-
- //Log.BenchmarkEnd(2);
- //Log.LogBenchmark('--> Setting Screen', 2);
-
- //Log.BenchmarkStart(2);
- Texture := TTextureUnit.Create;
- // FIXME: this does not seem to be correct as Limit.
- // Is the max. of either width or height.
- Texture.Limit := 1024*1024;
-
- //LoadTextures;
- //Log.BenchmarkEnd(2);
- //Log.LogBenchmark('--> Loading Textures', 2);
-
- {
- Log.BenchmarkStart(2);
- Lyric:= TLyric.Create;
- Log.BenchmarkEnd(2);
- Log.LogBenchmark('--> Loading Fonts', 2);
- }
-
- // Note: do not initialize video modules earlier. They might depend on some
- // SDL video functions or OpenGL extensions initialized in InitializeScreen()
- InitializeVideo();
-
- //Log.BenchmarkStart(2);
-
- Log.LogStatus('TDisplay.Create', 'UGraphic.Initialize3D');
- Display := TDisplay.Create;
- //Display.SetCursor;
-
- //Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2);
-
- //Log.LogStatus('Loading Screens', 'Initialize3D');
- //Log.BenchmarkStart(3);
-
- Log.LogStatus('Loading Font Textures', 'UGraphic.Initialize3D');
- LoadFontTextures();
-
- // Show the Loading Screen -------------
- Log.LogStatus('Loading Loading Screen', 'UGraphic.Initialize3D');
- LoadLoadingScreen;
-
-
- Log.LogStatus(' Loading Textures', 'UGraphic.Initialize3D');
- LoadTextures; // jb
-
-
-
- // now that we have something to display while loading,
- // start thread that loads the rest of ultrastar
- //Mutex := SDL_CreateMutex;
- //SDL_UnLockMutex(Mutex);
-
- // does not work this way because the loading thread tries to access opengl.
- // See comment below
- //LoadingThread := SDL_CreateThread(@LoadingThread, nil);
-
- // this would be run in the loadingthread
- Log.LogStatus(' Loading Screens', 'UGraphic.Initialize3D');
- LoadScreens;
-
-
- // TODO:
- // here should be a loop which
- // * draws the loading screen (form time to time)
- // * controlls the "process of the loading screen"
- // * checks if the loadingthread has loaded textures (check mutex) and
- // * load the textures into opengl
- // * tells the loadingthread, that the memory for the texture can be reused
- // to load the netx texture (over another mutex)
- // * runs as long as the loadingthread tells, that everything is loaded and ready (using a third mutex)
- //
- // therefor loadtexture have to be changed, that it, instat of caling some opengl functions
- // for itself, it should change mutex
- // the mainthread have to know somehow what opengl function have to be called with which parameters like
- // texturetype, textureobjekt, textur-buffer-adress, ...
-
- // wait for loading thread to finish
- // currently does not work this way
- // SDL_WaitThread(LoadingThread, I);
- // SDL_DestroyMutex(Mutex);
-
- Display.CurrentScreen^.FadeTo( @ScreenMain );
-
- Log.BenchmarkEnd(2);
- Log.LogBenchmark('--> Loading Screens', 2);
-
- Log.LogStatus('Finish', 'Initialize3D');
-end;
-
-procedure SwapBuffers;
-begin
- SDL_GL_SwapBuffers;
- glMatrixMode(GL_PROJECTION);
- glLoadIdentity;
- glOrtho(0, RenderW, RenderH, 0, -1, 100);
- glMatrixMode(GL_MODELVIEW);
-end;
-
-procedure Reinitialize3D;
-begin
- InitializeScreen;
-end;
-
-procedure InitializeScreen;
-var
- S: string;
- I: integer;
- W, H: integer;
- Depth: Integer;
- Fullscreen: boolean;
-begin
- if (Params.Screens <> -1) then
- Screens := Params.Screens + 1
- else
- Screens := Ini.Screens + 1;
-
- // Set minimum color component sizes
- // Note: do not request an alpha plane with SDL_GL_ALPHA_SIZE here as
- // some cards/implementations do not support them (SDL_SetVideoMode fails).
- // We do not the alpha plane anymore since offscreen rendering in back-buffer
- // was removed.
- SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5);
- SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 5);
- SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 5);
-
- SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16); // Z-Buffer depth
- SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1);
-
- // VSYNC works for windows only at the moment. SDL_GL_SWAP_CONTROL under
- // linux uses GLX_MESA_swap_control which is not supported by nvidea cards.
- // Maybe use glXSwapIntervalSGI(1) from the GLX_SGI_swap_control extension instead.
- //SDL_GL_SetAttribute(SDL_GL_SWAP_CONTROL, 1); // VSYNC (currently Windows only)
-
- // If there is a resolution in Parameters, use it, else use the Ini value
- I := Params.Resolution;
- if (I <> -1) then
- S := IResolution[I]
- else
- S := IResolution[Ini.Resolution];
-
- I := Pos('x', S);
- W := StrToInt(Copy(S, 1, I-1)) * Screens;
- H := StrToInt(Copy(S, I+1, 1000));
-
- if (Params.Depth <> -1) then
- Depth := Params.Depth
- else
- Depth := Ini.Depth;
-
- Log.LogStatus('SDL_SetVideoMode', 'Initialize3D');
-
- // check whether to start in fullscreen or windowed mode.
- // The command-line parameters take precedence over the ini settings.
- Fullscreen := ((Ini.FullScreen = 1) or (Params.ScreenMode = scmFullscreen)) and
- not (Params.ScreenMode = scmWindowed);
-
- if Fullscreen then
- begin
- Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Full Screen');
- screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN );
- end
- else
- begin
- Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Windowed');
- screen := SDL_SetVideoMode(W, H, 0, SDL_OPENGL or SDL_RESIZABLE);
- end;
-
- SDL_ShowCursor(0);
-
- if (screen = nil) then
- begin
- Log.LogCritical('SDL_SetVideoMode Failed', 'Initialize3D');
- end;
-
- LoadOpenGLExtensions();
-
- // define virtual (Render) and real (Screen) screen size
- RenderW := 800;
- RenderH := 600;
- ScreenW := W;
- ScreenH := H;
-
- // clear screen once window is being shown
- // Note: SwapBuffers uses RenderW/H, so they must be defined before
- glClearColor(1, 1, 1, 1);
- glClear(GL_COLOR_BUFFER_BIT);
- SwapBuffers;
-end;
-
-procedure LoadLoadingScreen;
-begin
- ScreenLoading := TScreenLoading.Create;
- ScreenLoading.OnShow;
-
- Display.CurrentScreen := @ScreenLoading;
-
- SwapBuffers;
-
- ScreenLoading.Draw;
- Display.Draw;
-
- SwapBuffers;
-end;
-
-procedure LoadScreens;
-begin
-{ ScreenLoading := TScreenLoading.Create;
- ScreenLoading.OnShow;
- Display.CurrentScreen := @ScreenLoading;
- ScreenLoading.Draw;
- Display.Draw;
- SwapBuffers;
-}
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Loading', 3); Log.BenchmarkStart(3);
-{ ScreenWelcome := TScreenWelcome.Create; //'BG', 4, 3);
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Welcome', 3); Log.BenchmarkStart(3);}
- ScreenMain := TScreenMain.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Main', 3); Log.BenchmarkStart(3);
- ScreenName := TScreenName.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Name', 3); Log.BenchmarkStart(3);
- ScreenLevel := TScreenLevel.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Level', 3); Log.BenchmarkStart(3);
- ScreenSong := TScreenSong.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song', 3); Log.BenchmarkStart(3);
- ScreenSongMenu := TScreenSongMenu.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song Menu', 3); Log.BenchmarkStart(3);
- ScreenSing := TScreenSing.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing', 3); Log.BenchmarkStart(3);
- ScreenScore := TScreenScore.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Score', 3); Log.BenchmarkStart(3);
- ScreenTop5 := TScreenTop5.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Top5', 3); Log.BenchmarkStart(3);
- ScreenOptions := TScreenOptions.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options', 3); Log.BenchmarkStart(3);
- ScreenOptionsGame := TScreenOptionsGame.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Game', 3); Log.BenchmarkStart(3);
- ScreenOptionsGraphics := TScreenOptionsGraphics.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Graphics', 3); Log.BenchmarkStart(3);
- ScreenOptionsSound := TScreenOptionsSound.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Sound', 3); Log.BenchmarkStart(3);
- ScreenOptionsLyrics := TScreenOptionsLyrics.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Lyrics', 3); Log.BenchmarkStart(3);
- ScreenOptionsThemes := TScreenOptionsThemes.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Themes', 3); Log.BenchmarkStart(3);
- ScreenOptionsRecord := TScreenOptionsRecord.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Record', 3); Log.BenchmarkStart(3);
- ScreenOptionsAdvanced := TScreenOptionsAdvanced.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Advanced', 3); Log.BenchmarkStart(3);
- ScreenEditSub := TScreenEditSub.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Sub', 3); Log.BenchmarkStart(3);
- ScreenEdit := TScreenEdit.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit', 3); Log.BenchmarkStart(3);
- ScreenEditConvert := TScreenEditConvert.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen EditConvert', 3); Log.BenchmarkStart(3);
-// ScreenEditHeader := TScreenEditHeader.Create(Skin.ScoreBG);
-// Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Header', 3); Log.BenchmarkStart(3);
- ScreenOpen := TScreenOpen.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Open', 3); Log.BenchmarkStart(3);
- ScreenSingModi := TScreenSingModi.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing with Modi support', 3); Log.BenchmarkStart(3);
- ScreenSongMenu := TScreenSongMenu.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongMenu', 3); Log.BenchmarkStart(3);
- ScreenSongJumpto := TScreenSongJumpto.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongJumpto', 3); Log.BenchmarkStart(3);
- ScreenPopupCheck := TScreenPopupCheck.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Check)', 3); Log.BenchmarkStart(3);
- ScreenPopupError := TScreenPopupError.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Error)', 3); Log.BenchmarkStart(3);
- ScreenPopupInfo := TScreenPopupInfo.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Info)', 3); Log.BenchmarkStart(3);
- ScreenPartyNewRound := TScreenPartyNewRound.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyNewRound', 3); Log.BenchmarkStart(3);
- ScreenPartyScore := TScreenPartyScore.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyScore', 3); Log.BenchmarkStart(3);
- ScreenPartyWin := TScreenPartyWin.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyWin', 3); Log.BenchmarkStart(3);
- ScreenPartyOptions := TScreenPartyOptions.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyOptions', 3); Log.BenchmarkStart(3);
- ScreenPartyPlayer := TScreenPartyPlayer.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyPlayer', 3); Log.BenchmarkStart(3);
- ScreenStatMain := TScreenStatMain.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3);
- ScreenStatDetail := TScreenStatDetail.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Detail', 3); Log.BenchmarkStart(3);
- ScreenCredits := TScreenCredits.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Credits', 3); Log.BenchmarkStart(3);
-
-end;
-
-function LoadingThreadFunction: integer;
-begin
- LoadScreens;
- Result:= 1;
-end;
-
-procedure UnLoadScreens;
-begin
- ScreenMain.Destroy;
- ScreenName.Destroy;
- ScreenLevel.Destroy;
- ScreenSong.Destroy;
- ScreenSing.Destroy;
- ScreenScore.Destroy;
- ScreenTop5.Destroy;
- ScreenOptions.Destroy;
- ScreenOptionsGame.Destroy;
- ScreenOptionsGraphics.Destroy;
- ScreenOptionsSound.Destroy;
- ScreenOptionsLyrics.Destroy;
-// ScreenOptionsThemes.Destroy;
- ScreenOptionsRecord.Destroy;
- ScreenOptionsAdvanced.Destroy;
- ScreenEditSub.Destroy;
- ScreenEdit.Destroy;
- ScreenEditConvert.Destroy;
- ScreenOpen.Destroy;
- ScreenSingModi.Destroy;
- ScreenSongMenu.Destroy;
- ScreenSongJumpto.Destroy;
- ScreenPopupCheck.Destroy;
- ScreenPopupError.Destroy;
- ScreenPopupInfo.Destroy;
- ScreenPartyNewRound.Destroy;
- ScreenPartyScore.Destroy;
- ScreenPartyWin.Destroy;
- ScreenPartyOptions.Destroy;
- ScreenPartyPlayer.Destroy;
- ScreenStatMain.Destroy;
- ScreenStatDetail.Destroy;
-end;
-
-end.
diff --git a/src/base/UGraphicClasses.pas b/src/base/UGraphicClasses.pas
deleted file mode 100644
index cdaa238e..00000000
--- a/src/base/UGraphicClasses.pas
+++ /dev/null
@@ -1,720 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UGraphicClasses;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- UTexture,
- SDL;
-
-const
- DelayBetweenFrames : cardinal = 60;
-
-type
-
- TParticleType = (GoldenNote, PerfectNote, NoteHitTwinkle, PerfectLineTwinkle, ColoredStar, Flare);
-
- TColour3f = record
- r, g, b: real;
- end;
-
- TParticle = class
- X, Y : real; //Position
- Screen : integer;
- W, H : cardinal; //dimensions of particle
- Col : array of TColour3f; // Colour(s) of particle
- Scale : array of real; // Scaling factors of particle layers
- Frame : byte; //act. Frame
- Tex : cardinal; //Tex num from Textur Manager
- Live : byte; //How many Cycles before Kill
- RecIndex : integer; //To which rectangle this particle belongs (only GoldenNote)
- StarType : TParticleType; // GoldenNote | PerfectNote | NoteHitTwinkle | PerfectLineTwinkle
- Alpha : real; // used for fading...
- mX, mY : real; // movement-vector for PerfectLineTwinkle
- SizeMod : real; // experimental size modifier
- SurviveSentenceChange : Boolean;
-
- constructor Create(cX, cY : real;
- cScreen : integer;
- cLive : byte;
- cFrame : integer;
- cRecArrayIndex : integer;
- cStarType : TParticleType;
- Player : cardinal);
- destructor Destroy(); override;
- procedure Draw;
- procedure LiveOn;
- end;
-
- RectanglePositions = record
- xTop, yTop, xBottom, yBottom : real;
- TotalStarCount : integer;
- CurrentStarCount : integer;
- Screen : integer;
- end;
-
- PerfectNotePositions = record
- xPos, yPos : real;
- Screen : integer;
- end;
-
- TEffectManager = class
- Particle : array of TParticle;
- LastTime : cardinal;
- RecArray : array of RectanglePositions;
- TwinkleArray : array[0..5] of real; // store x-position of last twinkle for every player
- PerfNoteArray : array of PerfectNotePositions;
-
- FlareTex: TTexture;
-
- constructor Create;
- destructor Destroy; override;
- procedure Draw;
- function Spawn(X, Y: real;
- Screen: integer;
- Live: byte;
- StartFrame: integer;
- RecArrayIndex: integer; // this is only used with GoldenNotes
- StarType: TParticleType;
- Player: cardinal // for PerfectLineTwinkle
- ): cardinal;
- procedure SpawnRec();
- procedure Kill(index: cardinal);
- procedure KillAll();
- procedure SentenceChange();
- procedure SaveGoldenStarsRec(Xtop, Ytop, Xbottom, Ybottom: real);
- procedure SavePerfectNotePos(Xtop, Ytop: real);
- procedure GoldenNoteTwinkle(Top, Bottom, Right: real; Player: integer);
- procedure SpawnPerfectLineTwinkle();
- end;
-
-var
- GoldenRec : TEffectManager;
-
-implementation
-
-uses
- SysUtils,
- Math,
- gl,
- UCommon,
- UDrawTexture,
- UGraphic,
- UIni,
- UNote,
- USkins,
- UThemes;
-
-//TParticle
-constructor TParticle.Create(cX, cY : real;
- cScreen : integer;
- cLive : byte;
- cFrame : integer;
- cRecArrayIndex : integer;
- cStarType : TParticleType;
- Player : cardinal);
-begin
- inherited Create;
- // in this constructor we set all initial values for our particle
- X := cX;
- Y := cY;
- Screen := cScreen;
- Live := cLive;
- Frame := cFrame;
- RecIndex := cRecArrayIndex;
- StarType := cStarType;
- Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out
- SetLength(Scale,1);
- Scale[0] := 1;
- SurviveSentenceChange := False;
- SizeMod := 1;
- case cStarType of
- GoldenNote:
- begin
- Tex := Tex_Note_Star.TexNum;
- W := 20;
- H := 20;
- SetLength(Scale,4);
- Scale[1] := 0.8;
- Scale[2] := 0.4;
- Scale[3] := 0.3;
- SetLength(Col,4);
- Col[0].r := 1;
- Col[0].g := 0.7;
- Col[0].b := 0.1;
-
- Col[1].r := 1;
- Col[1].g := 1;
- Col[1].b := 0.4;
-
- Col[2].r := 1;
- Col[2].g := 1;
- Col[2].b := 1;
-
- Col[3].r := 1;
- Col[3].g := 1;
- Col[3].b := 1;
- end;
- PerfectNote:
- begin
- Tex := Tex_Note_Perfect_Star.TexNum;
- W := 30;
- H := 30;
- SetLength(Col,1);
- Col[0].r := 1;
- Col[0].g := 1;
- Col[0].b := 0.95;
- end;
- NoteHitTwinkle:
- begin
- Tex := Tex_Note_Star.TexNum;
- Alpha := (Live/16); // linear fade-out
- W := 15;
- H := 15;
- Setlength(Col,1);
- Col[0].r := 1;
- Col[0].g := 1;
- Col[0].b := RandomRange(10*Live,100)/90; //0.9;
- end;
- PerfectLineTwinkle:
- begin
- Tex := Tex_Note_Star.TexNum;
- W := RandomRange(10,20);
- H := W;
- SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1);
- SurviveSentenceChange := True;
- // assign colours according to player given
- SetLength(Scale,3);
- Scale[1] := 0.3;
- Scale[2] := 0.2;
- SetLength(Col,3);
- case Player of
- 0: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P1Light');
- 1: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P2Light');
- 2: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P3Light');
- 3: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P4Light');
- 4: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P5Light');
- 5: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P6Light');
- else LoadColor(Col[0].r,Col[0].g,Col[0].b,'P1Light');
- end;
- Col[1].r := 1;
- Col[1].g := 1;
- Col[1].b := 0.4;
- Col[2].r := Col[0].r+0.5;
- Col[2].g := Col[0].g+0.5;
- Col[2].b := Col[0].b+0.5;
- mX := RandomRange(-5,5);
- mY := RandomRange(-5,5);
- end;
- ColoredStar:
- begin
- Tex := Tex_Note_Star.TexNum;
- W := RandomRange(10,20);
- H := W;
- SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1);
- SurviveSentenceChange := True;
- // assign colours according to player given
- SetLength(Scale,1);
- SetLength(Col,1);
- Col[0].b := (Player and $ff)/255;
- Col[0].g := ((Player shr 8) and $ff)/255;
- Col[0].r := ((Player shr 16) and $ff)/255;
- mX := 0;
- mY := 0;
- end;
- Flare:
- begin
- Tex := Tex_Note_Star.TexNum;
- W := 7;
- H := 7;
- SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1);
- mX := RandomRange(-5,5);
- mY := RandomRange(-5,5);
- SetLength(Scale,4);
- Scale[1] := 0.8;
- Scale[2] := 0.4;
- Scale[3] := 0.3;
- SetLength(Col,4);
- Col[0].r := 1;
- Col[0].g := 0.7;
- Col[0].b := 0.1;
-
- Col[1].r := 1;
- Col[1].g := 1;
- Col[1].b := 0.4;
-
- Col[2].r := 1;
- Col[2].g := 1;
- Col[2].b := 1;
-
- Col[3].r := 1;
- Col[3].g := 1;
- Col[3].b := 1;
-
- end;
- else // just some random default values
- begin
- Tex := Tex_Note_Star.TexNum;
- Alpha := 1;
- W := 20;
- H := 20;
- SetLength(Col,1);
- Col[0].r := 1;
- Col[0].g := 1;
- Col[0].b := 1;
- end;
- end;
-end;
-
-destructor TParticle.Destroy();
-begin
- SetLength(Scale,0);
- SetLength(Col,0);
- inherited;
-end;
-
-procedure TParticle.LiveOn;
-begin
- //Live = 0 => Live forever ?? but if this is 0 they would be killed in the Manager at Draw
- if (Live > 0) then
- Dec(Live);
-
- // animate frames
- Frame := ( Frame + 1 ) mod 16;
-
- // make our particles do funny stuff (besides being animated)
- // changes of any particle-values throughout its life are done here
- case StarType of
- GoldenNote:
- begin
- Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out
- end;
- PerfectNote:
- begin
- Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out
- end;
- NoteHitTwinkle:
- begin
- Alpha := (Live/10); // linear fade-out
- end;
- PerfectLineTwinkle:
- begin
- Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out
- SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1);
- // move around
- X := X + mX;
- Y := Y + mY;
- end;
- ColoredStar:
- begin
- Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out
- end;
- Flare:
- begin
- Alpha := (-cos((Frame+1)/16*1.7*pi+0.3*pi)+1); // neat fade-in-and-out
- SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1);
- // move around
- X := X + mX;
- Y := Y + mY;
- mY := mY+1.8;
-// mX := mX/2;
- end;
- end;
-end;
-
-procedure TParticle.Draw;
-var
- L: cardinal;
-begin
- if ScreenAct = Screen then
- // this draws (multiple) texture(s) of our particle
- for L := 0 to High(Col) do
- begin
- glColor4f(Col[L].r, Col[L].g, Col[L].b, Alpha);
-
- glBindTexture(GL_TEXTURE_2D, Tex);
- glEnable(GL_TEXTURE_2D);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glEnable(GL_BLEND);
-
- glBegin(GL_QUADS);
- glTexCoord2f((1/16) * Frame, 0); glVertex2f(X-W*Scale[L]*SizeMod, Y-H*Scale[L]*SizeMod);
- glTexCoord2f((1/16) * Frame + (1/16), 0); glVertex2f(X-W*Scale[L]*SizeMod, Y+H*Scale[L]*SizeMod);
- glTexCoord2f((1/16) * Frame + (1/16), 1); glVertex2f(X+W*Scale[L]*SizeMod, Y+H*Scale[L]*SizeMod);
- glTexCoord2f((1/16) * Frame, 1); glVertex2f(X+W*Scale[L]*SizeMod, Y-H*Scale[L]*SizeMod);
- glEnd;
- end;
- glcolor4f(1,1,1,1);
-end;
-// end of TParticle
-
-// TEffectManager
-
-constructor TEffectManager.Create;
-var
- c: cardinal;
-begin
- inherited;
- LastTime := SDL_GetTicks();
- for c := 0 to 5 do
- begin
- TwinkleArray[c] := 0;
- end;
-end;
-
-destructor TEffectManager.Destroy;
-begin
- Killall;
- inherited;
-end;
-
-
-procedure TEffectManager.Draw;
-var
- I: integer;
- CurrentTime: cardinal;
-//const
-// DelayBetweenFrames : cardinal = 100;
-begin
-
- CurrentTime := SDL_GetTicks();
- //Manage particle life
- if (CurrentTime - LastTime) > DelayBetweenFrames then
- begin
- LastTime := CurrentTime;
- for I := 0 to high(Particle) do
- Particle[I].LiveOn;
- end;
-
- I := 0;
- //Kill dead particles
- while (I <= High(Particle)) do
- begin
- if (Particle[I].Live <= 0) then
- begin
- kill(I);
- end
- else
- begin
- inc(I);
- end;
- end;
-
- //Draw
- for I := 0 to high(Particle) do
- begin
- Particle[I].Draw;
- end;
-end;
-
-// this method creates just one particle
-function TEffectManager.Spawn(X, Y: real; Screen: integer; Live: byte; StartFrame : integer; RecArrayIndex : integer; StarType : TParticleType; Player: cardinal): cardinal;
-begin
- Result := Length(Particle);
- SetLength(Particle, (Result + 1));
- Particle[Result] := TParticle.Create(X, Y, Screen, Live, StartFrame, RecArrayIndex, StarType, Player);
-end;
-
-// manage Sparkling of GoldenNote Bars
-procedure TEffectManager.SpawnRec();
-var
- Xkatze, Ykatze : real;
- RandomFrame : integer;
- P : integer; // P as seen on TV as Positionman
-begin
-//Spawn a random amount of stars within the given coordinates
-//RandomRange(0,14) <- this one starts at a random frame, 16 is our last frame - would be senseless to start a particle with 16, cause it would be dead at the next frame
- for P := 0 to high(RecArray) do
- begin
- while (RecArray[P].TotalStarCount > RecArray[P].CurrentStarCount) do
- begin
- Xkatze := RandomRange(Ceil(RecArray[P].xTop), Ceil(RecArray[P].xBottom));
- Ykatze := RandomRange(Ceil(RecArray[P].yTop), Ceil(RecArray[P].yBottom));
- RandomFrame := RandomRange(0,14);
- // Spawn a GoldenNote Particle
- Spawn(Xkatze, Ykatze, RecArray[P].Screen, 16 - RandomFrame, RandomFrame, P, GoldenNote, 0);
- inc(RecArray[P].CurrentStarCount);
- end;
- end;
- draw;
-end;
-
-// kill one particle (with given index in our particle array)
-procedure TEffectManager.Kill(Index: cardinal);
-var
- LastParticleIndex : integer;
-begin
-// delete particle indexed by Index,
-// overwrite it's place in our particle-array with the particle stored at the last array index,
-// shorten array
- LastParticleIndex := high(Particle);
- if not(LastParticleIndex = -1) then // is there still a particle to delete?
- begin
- if not(Particle[Index].RecIndex = -1) then // if it is a GoldenNote particle...
- dec(RecArray[Particle[Index].RecIndex].CurrentStarCount); // take care of its associated GoldenRec
- // now get rid of that particle
- Particle[Index].Destroy;
- Particle[Index] := Particle[LastParticleIndex];
- SetLength(Particle, LastParticleIndex);
- end;
-end;
-
-// clean up all particles and management structures
-procedure TEffectManager.KillAll();
-var
- c: cardinal;
-begin
-//It's the kill all kennies rotuine
- while Length(Particle) > 0 do // kill all existing particles
- Kill(0);
- SetLength(RecArray,0); // remove GoldenRec positions
- SetLength(PerfNoteArray,0); // remove PerfectNote positions
- for c := 0 to 5 do
- begin
- TwinkleArray[c] := 0; // reset GoldenNoteHit memory
- end;
-end;
-
-procedure TEffectManager.SentenceChange();
-var
- c: cardinal;
-begin
- c := 0;
- while c <= High(Particle) do
- begin
- if Particle[c].SurviveSentenceChange then
- inc(c)
- else
- Kill(c);
- end;
- SetLength(RecArray,0); // remove GoldenRec positions
- SetLength(PerfNoteArray,0); // remove PerfectNote positions
- for c := 0 to 5 do
- begin
- TwinkleArray[c] := 0; // reset GoldenNoteHit memory
- end;
-end;
-
-procedure TeffectManager.GoldenNoteTwinkle(Top, Bottom, Right: real; Player: integer);
-//Twinkle stars while golden note hit
-// this is called from UDraw.pas, SingDrawPlayerCzesc
-var
- C, P, XKatze, YKatze, LKatze: integer;
- H: real;
-begin
- // make sure we spawn only one time at one position
- if (TwinkleArray[Player] < Right) then
- for P := 0 to high(RecArray) do // Are we inside a GoldenNoteRectangle?
- begin
- H := (Top+Bottom)/2; // helper...
- with RecArray[P] do
- if ((xBottom >= Right) and (xTop <= Right) and
- (yTop <= H) and (yBottom >= H))
- and (Screen = ScreenAct) then
- begin
- TwinkleArray[Player] := Right; // remember twinkle position for this player
- for C := 1 to 10 do
- begin
- Ykatze := RandomRange(ceil(Top) , ceil(Bottom));
- XKatze := RandomRange(-7,3);
- LKatze := RandomRange(7,13);
- Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0);
- end;
- for C := 1 to 3 do
- begin
- Ykatze := RandomRange(ceil(Top)-6 , ceil(Top));
- XKatze := RandomRange(-5,1);
- LKatze := RandomRange(4,7);
- Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0);
- end;
- for C := 1 to 3 do
- begin
- Ykatze := RandomRange(ceil(Bottom), ceil(Bottom)+6);
- XKatze := RandomRange(-5,1);
- LKatze := RandomRange(4,7);
- Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0);
- end;
- for C := 1 to 3 do
- begin
- Ykatze := RandomRange(ceil(Top)-10 , ceil(Top)-6);
- XKatze := RandomRange(-5,1);
- LKatze := RandomRange(1,4);
- Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0);
- end;
- for C := 1 to 3 do
- begin
- Ykatze := RandomRange(ceil(Bottom)+6 , ceil(Bottom)+10);
- XKatze := RandomRange(-5,1);
- LKatze := RandomRange(1,4);
- Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0);
- end;
-
- exit; // found a matching GoldenRec, did spawning stuff... done
- end;
- end;
-end;
-
-procedure TEffectManager.SaveGoldenStarsRec(Xtop, Ytop, Xbottom, Ybottom: real);
-var
- P : integer; // P like used in Positions
- NewIndex : integer;
-begin
- for P := 0 to high(RecArray) do // Do we already have that "new" position?
- begin
- if (ceil(RecArray[P].xTop) = ceil(Xtop)) and
- (ceil(RecArray[P].yTop) = ceil(Ytop)) and
- (ScreenAct = RecArray[p].Screen) then
- exit; // it's already in the array, so we don't have to create a new one
- end;
-
- // we got a new position, add the new positions to our array
- NewIndex := Length(RecArray);
- SetLength(RecArray, NewIndex + 1);
- RecArray[NewIndex].xTop := Xtop;
- RecArray[NewIndex].yTop := Ytop;
- RecArray[NewIndex].xBottom := Xbottom;
- RecArray[NewIndex].yBottom := Ybottom;
- RecArray[NewIndex].TotalStarCount := ceil(Xbottom - Xtop) div 12 + 3;
- RecArray[NewIndex].CurrentStarCount := 0;
- RecArray[NewIndex].Screen := ScreenAct;
-end;
-
-procedure TEffectManager.SavePerfectNotePos(Xtop, Ytop: real);
-var
- P : integer; // P like used in Positions
- NewIndex : integer;
- RandomFrame : integer;
- Xkatze, Ykatze : integer;
-begin
- for P := 0 to high(PerfNoteArray) do // Do we already have that "new" position?
- begin
- with PerfNoteArray[P] do
- if (ceil(xPos) = ceil(Xtop)) and (ceil(yPos) = ceil(Ytop)) and
- (Screen = ScreenAct) then
- exit; // it's already in the array, so we don't have to create a new one
- end; //for
-
- // we got a new position, add the new positions to our array
- NewIndex := Length(PerfNoteArray);
- SetLength(PerfNoteArray, NewIndex + 1);
- PerfNoteArray[NewIndex].xPos := Xtop;
- PerfNoteArray[NewIndex].yPos := Ytop;
- PerfNoteArray[NewIndex].Screen := ScreenAct;
-
- for P := 0 to 2 do
- begin
- Xkatze := RandomRange(ceil(Xtop) - 5 , ceil(Xtop) + 10);
- Ykatze := RandomRange(ceil(Ytop) - 5 , ceil(Ytop) + 10);
- RandomFrame := RandomRange(0,14);
- Spawn(Xkatze, Ykatze, ScreenAct, 16 - RandomFrame, RandomFrame, -1, PerfectNote, 0);
- end; //for
-
-end;
-
-procedure TEffectManager.SpawnPerfectLineTwinkle();
-var
- P, I, Life: cardinal;
- Left, Right, Top, Bottom: cardinal;
- cScreen: integer;
-begin
-// calculation of coordinates done with hardcoded values like in UDraw.pas
-// might need to be adjusted if drawing of SingScreen is modified
-// coordinates may still be a bit weird and need adjustment
- if Ini.SingWindow = 0 then
- begin
- Left := 130;
- end
- else
- begin
- Left := 30;
- end;
- Right := 770;
- // spawn effect for every player with a perfect line
- for P := 0 to PlayersPlay-1 do
- if Player[P].LastSentencePerfect then
- begin
- // calculate area where notes of this player are drawn
- case PlayersPlay of
- 1: begin
- Bottom := Skin_P2_NotesB+10;
- Top := Bottom-105;
- cScreen := 1;
- end;
- 2,4: begin
- case P of
- 0,2: begin
- Bottom := Skin_P1_NotesB+10;
- Top := Bottom-105;
- end;
- else begin
- Bottom := Skin_P2_NotesB+10;
- Top := Bottom-105;
- end;
- end;
- case P of
- 0,1: cScreen := 1;
- else cScreen := 2;
- end;
- end;
- 3,6: begin
- case P of
- 0,3: begin
- Top := 130;
- Bottom := Top+85;
- end;
- 1,4: begin
- Top := 255;
- Bottom := Top+85;
- end;
- 2,5: begin
- Top := 380;
- Bottom := Top+85;
- end;
- end;
- case P of
- 0,1,2: cScreen := 1;
- else cScreen := 2;
- end;
- end;
- end;
- // spawn Sparkling Stars inside calculated coordinates
- for I := 0 to 80 do
- begin
- Life := RandomRange(8,16);
- Spawn(RandomRange(Left,Right), RandomRange(Top,Bottom), cScreen, Life, 16-Life, -1, PerfectLineTwinkle, P);
- end;
- end;
-end;
-
-end.
-
diff --git a/src/base/UIni.pas b/src/base/UIni.pas
deleted file mode 100644
index 998d19fb..00000000
--- a/src/base/UIni.pas
+++ /dev/null
@@ -1,1219 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UIni;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- Classes,
- IniFiles,
- SysUtils,
- ULog,
- UTextEncoding,
- UFilesystem,
- UPath;
-
-type
- // TInputDeviceConfig stores the configuration for an input device.
- // Configurations will be stored in the InputDeviceConfig array.
- // Note that not all devices listed in InputDeviceConfig are active devices.
- // Some might be unplugged and hence unavailable.
- // Available devices are held in TAudioInputProcessor.DeviceList. Each
- // TAudioInputDevice listed there has a CfgIndex field which is the index to
- // its configuration in the InputDeviceConfig array.
- // Name:
- // the name of the input device
- // Input:
- // the index of the input source to use for recording
- // ChannelToPlayerMap:
- // mapping of recording channels to players, e.g. ChannelToPlayerMap[0] = 2
- // maps the channel 0 (left) to player 2. A player index of 0 means that
- // the channel is not assigned to a player.
- PInputDeviceConfig = ^TInputDeviceConfig;
- TInputDeviceConfig = record
- Name: string;
- Input: integer;
- ChannelToPlayerMap: array of integer;
- end;
-
-type
-
-//Options
-
- TVisualizerOption = (voOff, voWhenNoVideo, voOn);
- TBackgroundMusicOption = (bmoOff, bmoOn);
- TIni = class
- private
- function ExtractKeyIndex(const Key, Prefix, Suffix: string): integer;
- function GetMaxKeyIndex(Keys: TStringList; const Prefix, Suffix: string): integer;
- function GetArrayIndex(const SearchArray: array of UTF8String; Value: string; CaseInsensitiv: boolean = false): integer;
- function ReadArrayIndex(const SearchArray: array of UTF8String; IniFile: TCustomIniFile;
- IniSection: string; IniProperty: string; Default: integer): integer;
-
- procedure TranslateOptionValues;
- procedure LoadInputDeviceCfg(IniFile: TMemIniFile);
- procedure SaveInputDeviceCfg(IniFile: TIniFile);
- procedure LoadThemes(IniFile: TCustomIniFile);
- procedure LoadPaths(IniFile: TCustomIniFile);
- procedure LoadScreenModes(IniFile: TCustomIniFile);
-
- public
- Name: array[0..11] of UTF8String;
-
- // Templates for Names Mod
- NameTeam: array[0..2] of UTF8String;
- NameTemplate: array[0..11] of UTF8String;
-
- //Filename of the opened iniFile
- Filename: IPath;
-
- // Game
- Players: integer;
- Difficulty: integer;
- Language: integer;
- Tabs: integer;
- TabsAtStartup: integer; //Tabs at Startup fix
- Sorting: integer;
- Debug: integer;
-
- // Graphics
- Screens: integer;
- Resolution: integer;
- Depth: integer;
- VisualizerOption: integer;
- FullScreen: integer;
- TextureSize: integer;
- SingWindow: integer;
- Oscilloscope: integer;
- Spectrum: integer;
- Spectrograph: integer;
- MovieSize: integer;
-
- // Sound
- MicBoost: integer;
- ClickAssist: integer;
- BeatClick: integer;
- SavePlayback: integer;
- ThresholdIndex: integer;
- AudioOutputBufferSizeIndex: integer;
- VoicePassthrough: integer;
-
- //Song Preview
- PreviewVolume: integer;
- PreviewFading: integer;
-
- // Lyrics
- LyricsFont: integer;
- LyricsEffect: integer;
- Solmization: integer;
- NoteLines: integer;
-
- // Themes
- Theme: integer;
- SkinNo: integer;
- Color: integer;
- BackgroundMusicOption: integer;
-
- // Record
- InputDeviceConfig: array of TInputDeviceConfig;
-
- // Advanced
- LoadAnimation: integer;
- EffectSing: integer;
- ScreenFade: integer;
- AskBeforeDel: integer;
- OnSongClick: integer;
- LineBonus: integer;
- PartyPopup: integer;
-
- // Controller
- Joypad: integer;
- Mouse: integer;
-
- procedure Load();
- procedure Save();
- procedure SaveNames;
- procedure SaveLevel;
- end;
-
-var
- Ini: TIni;
- IResolution: array of UTF8String;
- ILanguage: array of UTF8String;
- ITheme: array of UTF8String;
- ISkin: array of UTF8String;
-
-const
- IPlayers: array[0..4] of UTF8String = ('1', '2', '3', '4', '6');
- IPlayersVals: array[0..4] of integer = ( 1 , 2 , 3 , 4 , 6 );
-
- IDifficulty: array[0..2] of UTF8String = ('Easy', 'Medium', 'Hard');
- ITabs: array[0..1] of UTF8String = ('Off', 'On');
-
- ISorting: array[0..6] of UTF8String = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Artist2');
- sEdition = 0;
- sGenre = 1;
- sLanguage = 2;
- sFolder = 3;
- sTitle = 4;
- sArtist = 5;
- sArtist2 = 6;
-
- IDebug: array[0..1] of UTF8String = ('Off', 'On');
-
- IScreens: array[0..1] of UTF8String = ('1', '2');
- IFullScreen: array[0..1] of UTF8String = ('Off', 'On');
- IDepth: array[0..1] of UTF8String = ('16 bit', '32 bit');
- IVisualizer: array[0..2] of UTF8String = ('Off', 'WhenNoVideo','On');
-
- IBackgroundMusic: array[0..1] of UTF8String = ('Off', 'On');
-
- ITextureSize: array[0..3] of UTF8String = ('64', '128', '256', '512');
- ITextureSizeVals: array[0..3] of integer = ( 64, 128, 256, 512);
-
- ISingWindow: array[0..1] of UTF8String = ('Small', 'Big');
-
- //SingBar Mod
- IOscilloscope: array[0..1] of UTF8String = ('Off', 'On');
-
- ISpectrum: array[0..1] of UTF8String = ('Off', 'On');
- ISpectrograph: array[0..1] of UTF8String = ('Off', 'On');
- IMovieSize: array[0..2] of UTF8String = ('Half', 'Full [Vid]', 'Full [BG+Vid]');
-
- IClickAssist: array[0..1] of UTF8String = ('Off', 'On');
- IBeatClick: array[0..1] of UTF8String = ('Off', 'On');
- ISavePlayback: array[0..1] of UTF8String = ('Off', 'On');
-
- IThreshold: array[0..3] of UTF8String = ('5%', '10%', '15%', '20%');
- IThresholdVals: array[0..3] of single = (0.05, 0.10, 0.15, 0.20);
-
- IVoicePassthrough: array[0..1] of UTF8String = ('Off', 'On');
-
- IAudioOutputBufferSize: array[0..9] of UTF8String = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536');
- IAudioOutputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 );
-
- IAudioInputBufferSize: array[0..9] of UTF8String = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536');
- IAudioInputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 );
-
- //Song Preview
- IPreviewVolume: array[0..10] of UTF8String = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%');
- IPreviewVolumeVals: array[0..10] of single = ( 0, 0.10, 0.20, 0.30, 0.40, 0.50, 0.60, 0.70, 0.80, 0.90, 1.00 );
-
- IPreviewFading: array[0..5] of UTF8String = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs');
- IPreviewFadingVals: array[0..5] of integer = ( 0, 1, 2, 3, 4, 5 );
-
- ILyricsFont: array[0..2] of UTF8String = ('Plain', 'OLine1', 'OLine2');
- ILyricsEffect: array[0..4] of UTF8String = ('Simple', 'Zoom', 'Slide', 'Ball', 'Shift');
- ISolmization: array[0..3] of UTF8String = ('Off', 'Euro', 'Jap', 'American');
- INoteLines: array[0..1] of UTF8String = ('Off', 'On');
-
- IColor: array[0..8] of UTF8String = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black');
-
- // Advanced
- ILoadAnimation: array[0..1] of UTF8String = ('Off', 'On');
- IEffectSing: array[0..1] of UTF8String = ('Off', 'On');
- IScreenFade: array[0..1] of UTF8String = ('Off', 'On');
- IAskbeforeDel: array[0..1] of UTF8String = ('Off', 'On');
- IOnSongClick: array[0..2] of UTF8String = ('Sing', 'Select Players', 'Open Menu');
- sStartSing = 0;
- sSelectPlayer = 1;
- sOpenMenu = 2;
-
- ILineBonus: array[0..1] of UTF8String = ('Off', 'On');
- IPartyPopup: array[0..1] of UTF8String = ('Off', 'On');
-
- IJoypad: array[0..1] of UTF8String = ('Off', 'On');
- IMouse: array[0..2] of UTF8String = ('Off', 'Hardware Cursor', 'Software Cursor');
-
- // Recording options
- IChannelPlayer: array[0..6] of UTF8String = ('Off', '1', '2', '3', '4', '5', '6');
- IMicBoost: array[0..3] of UTF8String = ('Off', '+6dB', '+12dB', '+18dB');
-
-var
- ILanguageTranslated: array of UTF8String;
-
- IDifficultyTranslated: array[0..2] of UTF8String = ('Easy', 'Medium', 'Hard');
- ITabsTranslated: array[0..1] of UTF8String = ('Off', 'On');
-
- ISortingTranslated: array[0..6] of UTF8String = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Artist2');
-
- IDebugTranslated: array[0..1] of UTF8String = ('Off', 'On');
-
- IFullScreenTranslated: array[0..1] of UTF8String = ('Off', 'On');
- IVisualizerTranslated: array[0..2] of UTF8String = ('Off', 'WhenNoVideo','On');
-
- IBackgroundMusicTranslated: array[0..1] of UTF8String = ('Off', 'On');
- ISingWindowTranslated: array[0..1] of UTF8String = ('Small', 'Big');
-
- //SingBar Mod
- IOscilloscopeTranslated: array[0..1] of UTF8String = ('Off', 'On');
-
- ISpectrumTranslated: array[0..1] of UTF8String = ('Off', 'On');
- ISpectrographTranslated: array[0..1] of UTF8String = ('Off', 'On');
- IMovieSizeTranslated: array[0..2] of UTF8String = ('Half', 'Full [Vid]', 'Full [BG+Vid]');
-
- IClickAssistTranslated: array[0..1] of UTF8String = ('Off', 'On');
- IBeatClickTranslated: array[0..1] of UTF8String = ('Off', 'On');
- ISavePlaybackTranslated: array[0..1] of UTF8String = ('Off', 'On');
-
- IVoicePassthroughTranslated: array[0..1] of UTF8String = ('Off', 'On');
-
- //Song Preview
- IPreviewVolumeTranslated: array[0..10] of UTF8String = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%');
-
- IAudioOutputBufferSizeTranslated: array[0..9] of UTF8String = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536');
-
- IAudioInputBufferSizeTranslated: array[0..9] of UTF8String = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536');
-
- IPreviewFadingTranslated: array[0..5] of UTF8String = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs');
-
- ILyricsFontTranslated: array[0..2] of UTF8String = ('Plain', 'OLine1', 'OLine2');
- ILyricsEffectTranslated: array[0..4] of UTF8String = ('Simple', 'Zoom', 'Slide', 'Ball', 'Shift');
- ISolmizationTranslated: array[0..3] of UTF8String = ('Off', 'Euro', 'Jap', 'American');
- INoteLinesTranslated: array[0..1] of UTF8String = ('Off', 'On');
-
- IColorTranslated: array[0..8] of UTF8String = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black');
-
- // Advanced
- ILoadAnimationTranslated: array[0..1] of UTF8String = ('Off', 'On');
- IEffectSingTranslated: array[0..1] of UTF8String = ('Off', 'On');
- IScreenFadeTranslated: array[0..1] of UTF8String = ('Off', 'On');
- IAskbeforeDelTranslated: array[0..1] of UTF8String = ('Off', 'On');
- IOnSongClickTranslated: array[0..2] of UTF8String = ('Sing', 'Select Players', 'Open Menu');
- ILineBonusTranslated: array[0..1] of UTF8String = ('Off', 'On');
- IPartyPopupTranslated: array[0..1] of UTF8String = ('Off', 'On');
-
- IJoypadTranslated: array[0..1] of UTF8String = ('Off', 'On');
- IMouseTranslated: array[0..2] of UTF8String = ('Off', 'Hardware Cursor', 'Software Cursor');
-
- // Recording options
- IChannelPlayerTranslated: array[0..6] of UTF8String = ('Off', '1', '2', '3', '4', '5', '6');
- IMicBoostTranslated: array[0..3] of UTF8String = ('Off', '+6dB', '+12dB', '+18dB');
-
-implementation
-
-uses
- StrUtils,
- SDL,
- UCommandLine,
- ULanguage,
- UPlatform,
- UMain,
- URecord,
- USkins,
- UPathUtils,
- UUnicodeUtils;
-
-(**
- * Translate and set the values of options, which need translation.
- *)
-procedure TIni.TranslateOptionValues;
-var
- I: integer;
-begin
- // Load Languagefile
- if (Params.Language <> -1) then
- ULanguage.Language.ChangeLanguage(ILanguage[Params.Language])
- else
- ULanguage.Language.ChangeLanguage(ILanguage[Ini.Language]);
-
- SetLength(ILanguageTranslated, Length(ILanguage));
- for I := 0 to High(ILanguage) do
- begin
- ILanguageTranslated[I] := ULanguage.Language.Translate(
- 'OPTION_VALUE_' + UpperCase(ILanguage[I])
- );
- end;
-
- IDifficultyTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_EASY');
- IDifficultyTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_MEDIUM');
- IDifficultyTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_HARD');
-
- ITabsTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- ITabsTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON');
-
- ISortingTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_EDITION');
- ISortingTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_GENRE');
- ISortingTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_LANGUAGE');
- ISortingTranslated[3] := ULanguage.Language.Translate('OPTION_VALUE_FOLDER');
- ISortingTranslated[4] := ULanguage.Language.Translate('OPTION_VALUE_TITLE');
- ISortingTranslated[5] := ULanguage.Language.Translate('OPTION_VALUE_ARTIST');
- ISortingTranslated[6] := ULanguage.Language.Translate('OPTION_VALUE_ARTIST2');
-
- IDebugTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- IDebugTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON');
-
- IFullScreenTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- IFullScreenTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON');
-
- IVisualizerTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- IVisualizerTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_WHENNOVIDEO');
- IVisualizerTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_ON');
-
- IBackgroundMusicTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- IBackgroundMusicTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON');
-
- ISingWindowTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_SMALL');
- ISingWindowTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_BIG');
-
- IOscilloscopeTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- IOscilloscopeTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON');
-
- ISpectrumTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- ISpectrumTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON');
-
- ISpectrographTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- ISpectrographTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON');
-
- IMovieSizeTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_HALF');
- IMovieSizeTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_FULL_VID');
- IMovieSizeTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_FULL_VID_BG');
-
- IClickAssistTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- IClickAssistTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON');
-
- IBeatClickTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- IBeatClickTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON');
-
- ISavePlaybackTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- ISavePlaybackTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON');
-
- IVoicePassthroughTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- IVoicePassthroughTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON');
-
- ILyricsFontTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_PLAIN');
- ILyricsFontTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_OLINE1');
- ILyricsFontTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_OLINE2');
-
- ILyricsEffectTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_SIMPLE');
- ILyricsEffectTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ZOOM');
- ILyricsEffectTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_SLIDE');
- ILyricsEffectTranslated[3] := ULanguage.Language.Translate('OPTION_VALUE_BALL');
- ILyricsEffectTranslated[4] := ULanguage.Language.Translate('OPTION_VALUE_SHIFT');
-
- ISolmizationTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- ISolmizationTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_EURO');
- ISolmizationTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_JAPAN');
- ISolmizationTranslated[3] := ULanguage.Language.Translate('OPTION_VALUE_AMERICAN');
-
- INoteLinesTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- INoteLinesTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON');
-
- IColorTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_BLUE');
- IColorTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_GREEN');
- IColorTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_PINK');
- IColorTranslated[3] := ULanguage.Language.Translate('OPTION_VALUE_RED');
- IColorTranslated[4] := ULanguage.Language.Translate('OPTION_VALUE_VIOLET');
- IColorTranslated[5] := ULanguage.Language.Translate('OPTION_VALUE_ORANGE');
- IColorTranslated[6] := ULanguage.Language.Translate('OPTION_VALUE_YELLOW');
- IColorTranslated[7] := ULanguage.Language.Translate('OPTION_VALUE_BROWN');
- IColorTranslated[8] := ULanguage.Language.Translate('OPTION_VALUE_BLACK');
-
- // Advanced
- ILoadAnimationTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- ILoadAnimationTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON');
-
- IEffectSingTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- IEffectSingTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON');
-
- IScreenFadeTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- IScreenFadeTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON');
-
- IAskbeforeDelTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- IAskbeforeDelTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON');
-
- IOnSongClickTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_SING');
- IOnSongClickTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_SELECT_PLAYERS');
- IOnSongClickTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_OPEN_MENU');
-
- ILineBonusTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- ILineBonusTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON');
-
- IPartyPopupTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- IPartyPopupTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON');
-
- IJoypadTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- IJoypadTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON');
-
- IMouseTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- IMouseTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_HARDWARE_CURSOR');
- IMouseTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_SOFTWARE_CURSOR');
-
- IAudioOutputBufferSizeTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_AUTO');
- IAudioOutputBufferSizeTranslated[1] := '256';
- IAudioOutputBufferSizeTranslated[2] := '512';
- IAudioOutputBufferSizeTranslated[3] := '1024';
- IAudioOutputBufferSizeTranslated[4] := '2048';
- IAudioOutputBufferSizeTranslated[5] := '4096';
- IAudioOutputBufferSizeTranslated[6] := '8192';
- IAudioOutputBufferSizeTranslated[7] := '16384';
- IAudioOutputBufferSizeTranslated[8] := '32768';
- IAudioOutputBufferSizeTranslated[9] := '65536';
-
-
- IAudioInputBufferSizeTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_AUTO');
- IAudioInputBufferSizeTranslated[1] := '256';
- IAudioInputBufferSizeTranslated[2] := '512';
- IAudioInputBufferSizeTranslated[3] := '1024';
- IAudioInputBufferSizeTranslated[4] := '2048';
- IAudioInputBufferSizeTranslated[5] := '4096';
- IAudioInputBufferSizeTranslated[6] := '8192';
- IAudioInputBufferSizeTranslated[7] := '16384';
- IAudioInputBufferSizeTranslated[8] := '32768';
- IAudioInputBufferSizeTranslated[9] := '65536';
-
- //Song Preview
- IPreviewVolumeTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- IPreviewVolumeTranslated[1] := '10%';
- IPreviewVolumeTranslated[2] := '20%';
- IPreviewVolumeTranslated[3] := '30%';
- IPreviewVolumeTranslated[4] := '40%';
- IPreviewVolumeTranslated[5] := '50%';
- IPreviewVolumeTranslated[6] := '60%';
- IPreviewVolumeTranslated[7] := '70%';
- IPreviewVolumeTranslated[8] := '80%';
- IPreviewVolumeTranslated[9] := '90%';
- IPreviewVolumeTranslated[10] := '100%';
-
-
- IPreviewFadingTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- IPreviewFadingTranslated[1] := '1 ' + ULanguage.Language.Translate('OPTION_VALUE_SEC');
- IPreviewFadingTranslated[2] := '2 ' + ULanguage.Language.Translate('OPTION_VALUE_SECS');
- IPreviewFadingTranslated[3] := '3 ' + ULanguage.Language.Translate('OPTION_VALUE_SECS');
- IPreviewFadingTranslated[4] := '4 ' + ULanguage.Language.Translate('OPTION_VALUE_SECS');
- IPreviewFadingTranslated[5] := '5 ' + ULanguage.Language.Translate('OPTION_VALUE_SECS');
-
- // Recording options
- IChannelPlayerTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- IChannelPlayerTranslated[1] := '1';
- IChannelPlayerTranslated[2] := '2';
- IChannelPlayerTranslated[3] := '3';
- IChannelPlayerTranslated[4] := '4';
- IChannelPlayerTranslated[5] := '5';
- IChannelPlayerTranslated[6] := '6';
-
- IMicBoostTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- IMicBoostTranslated[1] := '+6dB';
- IMicBoostTranslated[2] := '+12dB';
- IMicBoostTranslated[3] := '+18dB';
-
-end;
-
-(**
- * Extracts an index of a key that is surrounded by a Prefix/Suffix pair.
- * Example: ExtractKeyIndex('MyKey[1]', '[', ']') will return 1.
- *)
-function TIni.ExtractKeyIndex(const Key, Prefix, Suffix: string): integer;
-var
- Value: string;
- Start: integer;
- PrefixPos, SuffixPos: integer;
-begin
- Result := -1;
-
- PrefixPos := Pos(Prefix, Key);
- if (PrefixPos <= 0) then
- Exit;
- SuffixPos := Pos(Suffix, Key);
- if (SuffixPos <= 0) then
- Exit;
-
- Start := PrefixPos + Length(Prefix);
-
- // copy all between prefix and suffix
- Value := Copy(Key, Start, SuffixPos - Start);
- Result := StrToIntDef(Value, -1);
-end;
-
-(**
- * Finds the maximum key-index in a key-list.
- * The indexes of the list are surrounded by Prefix/Suffix,
- * e.g. MyKey[1] (Prefix='[', Suffix=']')
- *)
-function TIni.GetMaxKeyIndex(Keys: TStringList; const Prefix, Suffix: string): integer;
-var
- i: integer;
- KeyIndex: integer;
-begin
- Result := -1;
-
- for i := 0 to Keys.Count-1 do
- begin
- KeyIndex := ExtractKeyIndex(Keys[i], Prefix, Suffix);
- if (KeyIndex > Result) then
- Result := KeyIndex;
- end;
-end;
-
-(**
- * Returns the index of Value in SearchArray
- * or -1 if Value is not in SearchArray.
- *)
-function TIni.GetArrayIndex(const SearchArray: array of UTF8String; Value: string;
- CaseInsensitiv: boolean = false): integer;
-var
- i: integer;
-begin
- Result := -1;
-
- for i := 0 to High(SearchArray) do
- begin
- if (SearchArray[i] = Value) or
- (CaseInsensitiv and (UpperCase(SearchArray[i]) = UpperCase(Value))) then
- begin
- Result := i;
- Break;
- end;
- end;
-end;
-
-(**
- * Reads the property IniSeaction:IniProperty from IniFile and
- * finds its corresponding index in SearchArray.
- * If SearchArray does not contain the property value, the default value is
- * returned.
- *)
-function TIni.ReadArrayIndex(const SearchArray: array of UTF8String; IniFile: TCustomIniFile;
- IniSection: string; IniProperty: string; Default: integer): integer;
-var
- StrValue: string;
-begin
- StrValue := IniFile.ReadString(IniSection, IniProperty, SearchArray[Default]);
- Result := GetArrayIndex(SearchArray, StrValue);
- if (Result = -1) then
- begin
- Result := Default;
- end;
-end;
-
-procedure TIni.LoadInputDeviceCfg(IniFile: TMemIniFile);
-var
- DeviceCfg: PInputDeviceConfig;
- DeviceIndex: integer;
- ChannelCount: integer;
- ChannelIndex: integer;
- RecordKeys: TStringList;
- i: integer;
-begin
- RecordKeys := TStringList.Create();
-
- // read all record-keys for filtering
- IniFile.ReadSection('Record', RecordKeys);
-
- SetLength(InputDeviceConfig, 0);
-
- for i := 0 to RecordKeys.Count-1 do
- begin
- // find next device-name
- DeviceIndex := ExtractKeyIndex(RecordKeys[i], 'DeviceName[', ']');
- if (DeviceIndex >= 0) then
- begin
- if not IniFile.ValueExists('Record', Format('DeviceName[%d]', [DeviceIndex])) then
- break;
-
- // resize list
- SetLength(InputDeviceConfig, Length(InputDeviceConfig)+1);
-
- // read an input device's config.
- // Note: All devices are appended to the list whether they exist or not.
- // Otherwise an external device's config will be lost if it is not
- // connected (e.g. singstar mics or USB-Audio devices).
- DeviceCfg := @InputDeviceConfig[High(InputDeviceConfig)];
- DeviceCfg.Name := IniFile.ReadString('Record', Format('DeviceName[%d]', [DeviceIndex]), '');
- DeviceCfg.Input := IniFile.ReadInteger('Record', Format('Input[%d]', [DeviceIndex]), 0);
-
- // find the largest channel-number of the current device in the ini-file
- ChannelCount := GetMaxKeyIndex(RecordKeys, 'Channel', Format('[%d]', [DeviceIndex]));
- if (ChannelCount < 0) then
- ChannelCount := 0;
-
- SetLength(DeviceCfg.ChannelToPlayerMap, ChannelCount);
-
- // read channel-to-player mapping for every channel of the current device
- // or set non-configured channels to no player (=0).
- for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do
- begin
- DeviceCfg.ChannelToPlayerMap[ChannelIndex] :=
- IniFile.ReadInteger('Record', Format('Channel%d[%d]', [ChannelIndex+1, DeviceIndex]), 0);
- end;
- end;
- end;
-
- RecordKeys.Free();
-
- // MicBoost
- MicBoost := GetArrayIndex(IMicBoost, IniFile.ReadString('Record', 'MicBoost', 'Off'));
- // Threshold
- ThresholdIndex := GetArrayIndex(IThreshold, IniFile.ReadString('Record', 'Threshold', IThreshold[1]));
-end;
-
-procedure TIni.SaveInputDeviceCfg(IniFile: TIniFile);
-var
- DeviceIndex: integer;
- ChannelIndex: integer;
-begin
- for DeviceIndex := 0 to High(InputDeviceConfig) do
- begin
- // DeviceName and DeviceInput
- IniFile.WriteString('Record', Format('DeviceName[%d]', [DeviceIndex+1]),
- InputDeviceConfig[DeviceIndex].Name);
- IniFile.WriteInteger('Record', Format('Input[%d]', [DeviceIndex+1]),
- InputDeviceConfig[DeviceIndex].Input);
-
- // Channel-to-Player Mapping
- for ChannelIndex := 0 to High(InputDeviceConfig[DeviceIndex].ChannelToPlayerMap) do
- begin
- IniFile.WriteInteger('Record',
- Format('Channel%d[%d]', [ChannelIndex+1, DeviceIndex+1]),
- InputDeviceConfig[DeviceIndex].ChannelToPlayerMap[ChannelIndex]);
- end;
- end;
-
- // MicBoost
- IniFile.WriteString('Record', 'MicBoost', IMicBoost[MicBoost]);
- // Threshold
- IniFile.WriteString('Record', 'Threshold', IThreshold[ThresholdIndex]);
-end;
-
-procedure TIni.LoadPaths(IniFile: TCustomIniFile);
-var
- PathStrings: TStringList;
- I: integer;
-begin
- PathStrings := TStringList.Create;
- IniFile.ReadSection('Directories', PathStrings);
-
- // Load song-paths
- for I := 0 to PathStrings.Count-1 do
- begin
- if (Pos('SONGDIR', UpperCase(PathStrings[I])) = 1) then
- begin
- AddSongPath(Path(IniFile.ReadString('Directories', PathStrings[I], '')));
- end;
- end;
-
- PathStrings.Free;
-end;
-
-procedure TIni.LoadThemes(IniFile: TCustomIniFile);
-var
- SearchResult: TSearchRec;
- ThemeIni: TMemIniFile;
- ThemeName: string;
- I: integer;
- Iter: IFileIterator;
- FileInfo: TFileInfo;
-begin
- // Theme
- SetLength(ITheme, 0);
- Log.LogStatus('Searching for Theme : ' + ThemePath.ToNative + '*.ini', 'Theme');
-
-
- Iter := FileSystem.FileFind(ThemePath.Append('*.ini'), 0);
- while (Iter.HasNext) do
- begin
- FileInfo := Iter.Next;
- Log.LogStatus('Found Theme: ' + FileInfo.Name.ToNative, 'Theme');
-
- //Read Themename from Theme
- ThemeIni := TMemIniFile.Create(FileInfo.Name.ToNative);
- ThemeName := UpperCase(ThemeIni.ReadString('Theme','Name', FileInfo.Name.SetExtension('').ToNative));
- ThemeIni.Free;
-
- //Search for Skins for this Theme
- for I := Low(Skin.Skin) to High(Skin.Skin) do
- begin
- if UpperCase(Skin.Skin[I].Theme) = ThemeName then
- begin
- SetLength(ITheme, Length(ITheme)+1);
- ITheme[High(ITheme)] := FileInfo.Name.SetExtension('').ToNative;
- break;
- end;
- end;
- end;
-
- // No Theme Found
- if (Length(ITheme) = 0) then
- begin
- Log.CriticalError('Could not find any valid Themes.');
- end;
-
- Theme := GetArrayIndex(ITheme, IniFile.ReadString('Themes', 'Theme', 'DELUXE'), true);
- if (Theme = -1) then
- Theme := 0;
-
- // Skin
- Skin.onThemeChange;
-
- SkinNo := GetArrayIndex(ISkin, IniFile.ReadString('Themes', 'Skin', ISkin[0]));
-end;
-
-procedure TIni.LoadScreenModes(IniFile: TCustomIniFile);
-
- // swap two strings
- procedure swap(var s1, s2: UTF8String);
- var
- s3: string;
- begin
- s3 := s1;
- s1 := s2;
- s2 := s3;
- end;
-
-var
- Modes: PPSDL_Rect;
- I: integer;
-begin
- // Screens
- Screens := GetArrayIndex(IScreens, IniFile.ReadString('Graphics', 'Screens', IScreens[0]));
-
- // FullScreen
- FullScreen := GetArrayIndex(IFullScreen, IniFile.ReadString('Graphics', 'FullScreen', 'On'));
-
- // Resolution
- SetLength(IResolution, 0);
-
- // Check if there are any modes available
- // TODO: we should seperate windowed and fullscreen modes. Otherwise it is not
- // possible to select a reasonable fullscreen mode when in windowed mode
- if IFullScreen[FullScreen] = 'On' then
- Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN)
- else
- Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_RESIZABLE) ;
-
- if (Modes = nil) then
- begin
- Log.LogStatus( 'No resolutions Found' , 'Video');
- end
- else if (Modes = PPSDL_Rect(-1)) then
- begin
- // Fallback to some standard resolutions
- SetLength(IResolution, 10);
- IResolution[0] := '640x480';
- IResolution[1] := '800x600';
- IResolution[2] := '1024x768';
- IResolution[3] := '1152x864';
- IResolution[4] := '1280x800';
- IResolution[5] := '1280x960';
- IResolution[6] := '1400x1050';
- IResolution[7] := '1440x900';
- IResolution[8] := '1600x1200';
- IResolution[9] := '1680x1050';
-
- Resolution := GetArrayIndex(IResolution, IniFile.ReadString('Graphics', 'Resolution', '800x600'));
- if Resolution = -1 then
- begin
- SetLength(IResolution, Length(IResolution) + 1);
- IResolution[High(IResolution)] := IniFile.ReadString('Graphics', 'Resolution', '800x600');
- Resolution := High(IResolution);
- end;
- end
- else
- begin
- while assigned( Modes^ ) do //this should solve the biggest wine problem | THANKS Linnex (11.11.07)
- begin
- Log.LogStatus( 'Found Video Mode : ' + IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h) , 'Video');
- SetLength(IResolution, Length(IResolution) + 1);
- IResolution[High(IResolution)] := IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h);
- Inc(Modes);
- end;
-
- // reverse order
- Log.LogStatus( 'Log size of resolution: ' + IntToStr(Length(IResolution)), 'Video');
- for I := 0 to (Length(IResolution) div 2) - 1 do
- begin
- swap(IResolution[I], IResolution[High(IResolution)-I]);
- end;
- Resolution := GetArrayIndex(IResolution, IniFile.ReadString('Graphics', 'Resolution', '800x600'));
-
- if Resolution = -1 then
- begin
- Resolution := GetArrayIndex(IResolution, '800x600');
- if Resolution = -1 then
- Resolution := 0;
- end;
- end;
-
- // if no modes were set, then failback to 800x600
- // as per http://sourceforge.net/forum/message.php?msg_id=4544965
- // THANKS : linnex at users.sourceforge.net
- if Length(IResolution) < 1 then
- begin
- Log.LogStatus( 'Found Video Mode : NONE !!! ( Defaulted to 800 x 600 )', 'Video');
- SetLength(IResolution, 1);
- IResolution[0] := '800x600';
- Resolution := 0;
- Log.LogStatus('SDL_ListModes Defaulted Res To : ' + IResolution[0] , 'Graphics - Resolutions');
-
- // Default to fullscreen OFF, in this case !
- FullScreen := 0;
- end;
-
- // Depth
- Depth := GetArrayIndex(IDepth, IniFile.ReadString('Graphics', 'Depth', '32 bit'));
-end;
-
-procedure TIni.Load();
-var
- IniFile: TMemIniFile;
- I: integer;
-begin
- GamePath := Platform.GetGameUserPath;
-
- Log.LogStatus( 'GamePath : ' +GamePath.ToNative , '' );
-
- if (Params.ConfigFile.IsSet) then
- FileName := Params.ConfigFile
- else
- FileName := GamePath.Append('config.ini');
-
- Log.LogStatus('Using config : ' + FileName.ToNative, 'Ini');
- IniFile := TMemIniFile.Create(FileName.ToNative);
-
- // Name
- for I := 0 to 11 do
- Name[I] := IniFile.ReadString('Name', 'P'+IntToStr(I+1), 'Player'+IntToStr(I+1));
-
- // Templates for Names Mod
- for I := 0 to 2 do
- NameTeam[I] := IniFile.ReadString('NameTeam', 'T'+IntToStr(I+1), 'Team'+IntToStr(I+1));
- for I := 0 to 11 do
- NameTemplate[I] := IniFile.ReadString('NameTemplate', 'Name'+IntToStr(I+1), 'Template'+IntToStr(I+1));
-
- // Players
- Players := GetArrayIndex(IPlayers, IniFile.ReadString('Game', 'Players', IPlayers[0]));
-
- // Difficulty
- Difficulty := GetArrayIndex(IDifficulty, IniFile.ReadString('Game', 'Difficulty', 'Easy'));
-
- // Language
- Language := GetArrayIndex(ILanguage, IniFile.ReadString('Game', 'Language', 'English'));
-
- // Tabs
- Tabs := GetArrayIndex(ITabs, IniFile.ReadString('Game', 'Tabs', ITabs[0]));
- TabsAtStartup := Tabs; //Tabs at Startup fix
-
- // Song Sorting
- Sorting := GetArrayIndex(ISorting, IniFile.ReadString('Game', 'Sorting', ISorting[0]));
-
- // Debug
- Debug := GetArrayIndex(IDebug, IniFile.ReadString('Game', 'Debug', IDebug[0]));
-
- LoadScreenModes(IniFile);
-
- // TextureSize
- TextureSize := GetArrayIndex(ITextureSize, IniFile.ReadString('Graphics', 'TextureSize', ITextureSize[1]));
-
- // SingWindow
- SingWindow := GetArrayIndex(ISingWindow, IniFile.ReadString('Graphics', 'SingWindow', 'Big'));
-
- // Oscilloscope
- Oscilloscope := GetArrayIndex(IOscilloscope, IniFile.ReadString('Graphics', 'Oscilloscope', IOscilloscope[0]));
-
- // Spectrum
- Spectrum := GetArrayIndex(ISpectrum, IniFile.ReadString('Graphics', 'Spectrum', 'Off'));
-
- // Spectrograph
- Spectrograph := GetArrayIndex(ISpectrograph, IniFile.ReadString('Graphics', 'Spectrograph', 'Off'));
-
- // MovieSize
- MovieSize := GetArrayIndex(IMovieSize, IniFile.ReadString('Graphics', 'MovieSize', IMovieSize[2]));
-
- // ClickAssist
- ClickAssist := GetArrayIndex(IClickAssist, IniFile.ReadString('Sound', 'ClickAssist', 'Off'));
-
- // BeatClick
- BeatClick := GetArrayIndex(IBeatClick, IniFile.ReadString('Sound', 'BeatClick', IBeatClick[0]));
-
- // SavePlayback
- SavePlayback := GetArrayIndex(ISavePlayback, IniFile.ReadString('Sound', 'SavePlayback', ISavePlayback[0]));
-
- // AudioOutputBufferSize
- AudioOutputBufferSizeIndex := ReadArrayIndex(IAudioOutputBufferSize, IniFile, 'Sound', 'AudioOutputBufferSize', 0);
-
- //Preview Volume
- PreviewVolume := GetArrayIndex(IPreviewVolume, IniFile.ReadString('Sound', 'PreviewVolume', IPreviewVolume[7]));
-
- //Preview Fading
- PreviewFading := GetArrayIndex(IPreviewFading, IniFile.ReadString('Sound', 'PreviewFading', IPreviewFading[3]));
-
- //AudioRepeat aka VoicePassthrough
- VoicePassthrough := GetArrayIndex(IVoicePassthrough, IniFile.ReadString('Sound', 'VoicePassthrough', IVoicePassthrough[0]));
-
- // Lyrics Font
- LyricsFont := GetArrayIndex(ILyricsFont, IniFile.ReadString('Lyrics', 'LyricsFont', ILyricsFont[0]));
-
- // Lyrics Effect
- LyricsEffect := GetArrayIndex(ILyricsEffect, IniFile.ReadString('Lyrics', 'LyricsEffect', ILyricsEffect[2]));
-
- // Solmization
- Solmization := GetArrayIndex(ISolmization, IniFile.ReadString('Lyrics', 'Solmization', ISolmization[0]));
-
- // NoteLines
- NoteLines := GetArrayIndex(INoteLines, IniFile.ReadString('Lyrics', 'NoteLines', INoteLines[1]));
-
- LoadThemes(IniFile);
-
- // Color
- Color := GetArrayIndex(IColor, IniFile.ReadString('Themes', 'Color', IColor[0]));
-
- LoadInputDeviceCfg(IniFile);
-
- // LoadAnimation
- LoadAnimation := GetArrayIndex(ILoadAnimation, IniFile.ReadString('Advanced', 'LoadAnimation', 'On'));
-
- // ScreenFade
- ScreenFade := GetArrayIndex(IScreenFade, IniFile.ReadString('Advanced', 'ScreenFade', 'On'));
-
- // Visualizations
- // this could be of use later..
- // VisualizerOption :=
- // TVisualizerOption(GetEnumValue(TypeInfo(TVisualizerOption),
- // IniFile.ReadString('Graphics', 'Visualization', 'Off')));
- // || VisualizerOption := TVisualizerOption(GetArrayIndex(IVisualizer, IniFile.ReadString('Graphics', 'Visualization', 'Off')));
- VisualizerOption := GetArrayIndex(IVisualizer, IniFile.ReadString('Graphics', 'Visualization', 'Off'));
-
-{**
- * Background music
- *}
- BackgroundMusicOption := GetArrayIndex(IBackgroundMusic, IniFile.ReadString('Sound', 'BackgroundMusic', 'Off'));
-
- // EffectSing
- EffectSing := GetArrayIndex(IEffectSing, IniFile.ReadString('Advanced', 'EffectSing', 'On'));
-
- // AskbeforeDel
- AskBeforeDel := GetArrayIndex(IAskbeforeDel, IniFile.ReadString('Advanced', 'AskbeforeDel', 'On'));
-
- // OnSongClick
- OnSongClick := GetArrayIndex(IOnSongClick, IniFile.ReadString('Advanced', 'OnSongClick', 'Sing'));
-
- // Linebonus
- LineBonus := GetArrayIndex(ILineBonus, IniFile.ReadString('Advanced', 'LineBonus', ILineBonus[1]));
-
- // PartyPopup
- PartyPopup := GetArrayIndex(IPartyPopup, IniFile.ReadString('Advanced', 'PartyPopup', 'On'));
-
- // Joypad
- Joypad := GetArrayIndex(IJoypad, IniFile.ReadString('Controller', 'Joypad', IJoypad[0]));
-
- // Mouse
- Mouse := GetArrayIndex(IMouse, IniFile.ReadString('Controller', 'Mouse', IMouse[2]));
-
- LoadPaths(IniFile);
-
- TranslateOptionValues;
-
- IniFile.Free;
-end;
-
-procedure TIni.Save;
-var
- IniFile: TIniFile;
-begin
- if (Filename.IsFile and Filename.IsReadOnly) then
- begin
- Log.LogError('Config-file is read-only', 'TIni.Save');
- Exit;
- end;
-
- IniFile := TIniFile.Create(Filename.ToNative);
-
- // Players
- IniFile.WriteString('Game', 'Players', IPlayers[Players]);
-
- // Difficulty
- IniFile.WriteString('Game', 'Difficulty', IDifficulty[Difficulty]);
-
- // Language
- IniFile.WriteString('Game', 'Language', ILanguage[Language]);
-
- // Tabs
- IniFile.WriteString('Game', 'Tabs', ITabs[Tabs]);
-
- // Sorting
- IniFile.WriteString('Game', 'Sorting', ISorting[Sorting]);
-
- // Debug
- IniFile.WriteString('Game', 'Debug', IDebug[Debug]);
-
- // Screens
- IniFile.WriteString('Graphics', 'Screens', IScreens[Screens]);
-
- // FullScreen
- IniFile.WriteString('Graphics', 'FullScreen', IFullScreen[FullScreen]);
-
- // Visualization
- IniFile.WriteString('Graphics', 'Visualization', IVisualizer[VisualizerOption]);
-
- // Resolution
- IniFile.WriteString('Graphics', 'Resolution', IResolution[Resolution]);
-
- // Depth
- IniFile.WriteString('Graphics', 'Depth', IDepth[Depth]);
-
- // TextureSize
- IniFile.WriteString('Graphics', 'TextureSize', ITextureSize[TextureSize]);
-
- // Sing Window
- IniFile.WriteString('Graphics', 'SingWindow', ISingWindow[SingWindow]);
-
- // Oscilloscope
- IniFile.WriteString('Graphics', 'Oscilloscope', IOscilloscope[Oscilloscope]);
-
- // Spectrum
- IniFile.WriteString('Graphics', 'Spectrum', ISpectrum[Spectrum]);
-
- // Spectrograph
- IniFile.WriteString('Graphics', 'Spectrograph', ISpectrograph[Spectrograph]);
-
- // Movie Size
- IniFile.WriteString('Graphics', 'MovieSize', IMovieSize[MovieSize]);
-
- // ClickAssist
- IniFile.WriteString('Sound', 'ClickAssist', IClickAssist[ClickAssist]);
-
- // BeatClick
- IniFile.WriteString('Sound', 'BeatClick', IBeatClick[BeatClick]);
-
- // AudioOutputBufferSize
- IniFile.WriteString('Sound', 'AudioOutputBufferSize', IAudioOutputBufferSize[AudioOutputBufferSizeIndex]);
-
- // Background music
- IniFile.WriteString('Sound', 'BackgroundMusic', IBackgroundMusic[BackgroundMusicOption]);
-
- // Song Preview
- IniFile.WriteString('Sound', 'PreviewVolume', IPreviewVolume[PreviewVolume]);
-
- // PreviewFading
- IniFile.WriteString('Sound', 'PreviewFading', IPreviewFading[PreviewFading]);
-
- // SavePlayback
- IniFile.WriteString('Sound', 'SavePlayback', ISavePlayback[SavePlayback]);
-
- // VoicePasstrough
- IniFile.WriteString('Sound', 'VoicePassthrough', IVoicePassthrough[VoicePassthrough]);
-
- // Lyrics Font
- IniFile.WriteString('Lyrics', 'LyricsFont', ILyricsFont[LyricsFont]);
-
- // Lyrics Effect
- IniFile.WriteString('Lyrics', 'LyricsEffect', ILyricsEffect[LyricsEffect]);
-
- // Solmization
- IniFile.WriteString('Lyrics', 'Solmization', ISolmization[Solmization]);
-
- // NoteLines
- IniFile.WriteString('Lyrics', 'NoteLines', INoteLines[NoteLines]);
-
- // Theme
- IniFile.WriteString('Themes', 'Theme', ITheme[Theme]);
-
- // Skin
- IniFile.WriteString('Themes', 'Skin', ISkin[SkinNo]);
-
- // Color
- IniFile.WriteString('Themes', 'Color', IColor[Color]);
-
- SaveInputDeviceCfg(IniFile);
-
- //LoadAnimation
- IniFile.WriteString('Advanced', 'LoadAnimation', ILoadAnimation[LoadAnimation]);
-
- //EffectSing
- IniFile.WriteString('Advanced', 'EffectSing', IEffectSing[EffectSing]);
-
- //ScreenFade
- IniFile.WriteString('Advanced', 'ScreenFade', IScreenFade[ScreenFade]);
-
- //AskbeforeDel
- IniFile.WriteString('Advanced', 'AskbeforeDel', IAskbeforeDel[AskBeforeDel]);
-
- //OnSongClick
- IniFile.WriteString('Advanced', 'OnSongClick', IOnSongClick[OnSongClick]);
-
- //Line Bonus
- IniFile.WriteString('Advanced', 'LineBonus', ILineBonus[LineBonus]);
-
- //Party Popup
- IniFile.WriteString('Advanced', 'PartyPopup', IPartyPopup[PartyPopup]);
-
- // Joypad
- IniFile.WriteString('Controller', 'Joypad', IJoypad[Joypad]);
-
- // Mouse
- IniFile.WriteString('Controller', 'Mouse', IMouse[Mouse]);
-
- // Directories (add a template if section is missing)
- // Note: Value must be ' ' and not '', otherwise no key is generated on Linux
- if (not IniFile.SectionExists('Directories')) then
- IniFile.WriteString('Directories', 'SongDir1', ' ');
-
- IniFile.Free;
-end;
-
-procedure TIni.SaveNames;
-var
- IniFile: TIniFile;
- I: integer;
-begin
- if not Filename.IsReadOnly() then
- begin
- IniFile := TIniFile.Create(Filename.ToNative);
-
- //Name Templates for Names Mod
- for I := 0 to High(Name) do
- IniFile.WriteString('Name', 'P' + IntToStr(I+1), Name[I]);
- for I := 0 to High(NameTeam) do
- IniFile.WriteString('NameTeam', 'T' + IntToStr(I+1), NameTeam[I]);
- for I := 0 to High(NameTemplate) do
- IniFile.WriteString('NameTemplate', 'Name' + IntToStr(I+1), NameTemplate[I]);
-
- IniFile.Free;
- end;
-end;
-
-procedure TIni.SaveLevel;
-var
- IniFile: TIniFile;
-begin
- if not Filename.IsReadOnly() then
- begin
- IniFile := TIniFile.Create(Filename.ToNative);
-
- // Difficulty
- IniFile.WriteString('Game', 'Difficulty', IDifficulty[Difficulty]);
-
- IniFile.Free;
- end;
-end;
-
-end.
diff --git a/src/base/UJoystick.pas b/src/base/UJoystick.pas
deleted file mode 100644
index 30808812..00000000
--- a/src/base/UJoystick.pas
+++ /dev/null
@@ -1,312 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UJoystick;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- SDL;
-
-type
- TJoyButton = record
- State: integer;
- Enabled: boolean;
- Type_: byte;
- Sym: cardinal;
- end;
-
- TJoyHatState = record
- State: Boolean;
- LastTick: Cardinal;
- Enabled: boolean;
- Type_: byte;
- Sym: cardinal;
- end;
-
- TJoyUnit = record
- Button: array[0..15] of TJoyButton;
- HatState: Array[0..3] of TJoyHatState;
- end;
-
- TJoy = class
- constructor Create;
- procedure Update;
- end;
-
-var
- Joy: TJoy;
- JoyUnit: TJoyUnit;
- SDL_Joy: PSDL_Joystick;
- JoyEvent: TSDL_Event;
-
-implementation
-
-uses SysUtils,
- ULog;
-
-constructor TJoy.Create;
-var
- B: integer;
- //N: integer;
-begin
- inherited;
-
- //Old Corvus5 Method
- {// joystick support
- SDL_JoystickEventState(SDL_IGNORE);
- SDL_InitSubSystem(SDL_INIT_JOYSTICK);
- if SDL_NumJoysticks <> 1 then
- Log.LogStatus('Joystick count <> 1', 'TJoy.Create');
-
- SDL_Joy := SDL_JoystickOpen(0);
- if SDL_Joy = nil then
- Log.LogError('SDL_JoystickOpen failed', 'TJoy.Create');
-
- if SDL_JoystickNumButtons(SDL_Joy) <> 16 then
- Log.LogStatus('Joystick button count <> 16', 'TJoy.Create');
-
-// SDL_JoystickEventState(SDL_ENABLE);
- // Events don't work - thay hang the whole application with SDL_JoystickEventState(SDL_ENABLE)
-
- // clear states
- for B := 0 to 15 do
- JoyUnit.Button[B].State := 1;
-
- // mapping
- JoyUnit.Button[1].Enabled := true;
- JoyUnit.Button[1].Type_ := SDL_KEYDOWN;
- JoyUnit.Button[1].Sym := SDLK_RETURN;
- JoyUnit.Button[2].Enabled := true;
- JoyUnit.Button[2].Type_ := SDL_KEYDOWN;
- JoyUnit.Button[2].Sym := SDLK_ESCAPE;
-
- JoyUnit.Button[12].Enabled := true;
- JoyUnit.Button[12].Type_ := SDL_KEYDOWN;
- JoyUnit.Button[12].Sym := SDLK_LEFT;
- JoyUnit.Button[13].Enabled := true;
- JoyUnit.Button[13].Type_ := SDL_KEYDOWN;
- JoyUnit.Button[13].Sym := SDLK_DOWN;
- JoyUnit.Button[14].Enabled := true;
- JoyUnit.Button[14].Type_ := SDL_KEYDOWN;
- JoyUnit.Button[14].Sym := SDLK_RIGHT;
- JoyUnit.Button[15].Enabled := true;
- JoyUnit.Button[15].Type_ := SDL_KEYDOWN;
- JoyUnit.Button[15].Sym := SDLK_UP;
- }
- //New Sarutas method
- SDL_JoystickEventState(SDL_IGNORE);
- SDL_InitSubSystem(SDL_INIT_JOYSTICK);
- if SDL_NumJoysticks < 1 then
- begin
- Log.LogError('No Joystick found');
- exit;
- end;
-
-
- SDL_Joy := SDL_JoystickOpen(0);
- if SDL_Joy = nil then
- begin
- Log.LogError('Could not Init Joystick');
- exit;
- end;
- //N := SDL_JoystickNumButtons(SDL_Joy);
- //if N < 6 then Log.LogStatus('Joystick button count < 6', 'TJoy.Create');
-
- for B := 0 to 5 do begin
- JoyUnit.Button[B].Enabled := true;
- JoyUnit.Button[B].State := 1;
- JoyUnit.Button[B].Type_ := SDL_KEYDOWN;
- end;
-
- JoyUnit.Button[0].Sym := SDLK_Return;
- JoyUnit.Button[1].Sym := SDLK_Escape;
- JoyUnit.Button[2].Sym := SDLK_M;
- JoyUnit.Button[3].Sym := SDLK_R;
-
- JoyUnit.Button[4].Sym := SDLK_RETURN;
- JoyUnit.Button[5].Sym := SDLK_ESCAPE;
-
- //Set HatState
- for B := 0 to 3 do begin
- JoyUnit.HatState[B].Enabled := true;
- JoyUnit.HatState[B].State := False;
- JoyUnit.HatState[B].Type_ := SDL_KEYDOWN;
- end;
-
- JoyUnit.HatState[0].Sym := SDLK_UP;
- JoyUnit.HatState[1].Sym := SDLK_RIGHT;
- JoyUnit.HatState[2].Sym := SDLK_DOWN;
- JoyUnit.HatState[3].Sym := SDLK_LEFT;
-end;
-
-procedure TJoy.Update;
-var
- B: integer;
- State: UInt8;
- Tick: Cardinal;
- Axes: Smallint;
-begin
- SDL_JoystickUpdate;
-
- //Manage Buttons
- for B := 0 to 15 do begin
- if (JoyUnit.Button[B].Enabled) and (JoyUnit.Button[B].State <> SDL_JoystickGetButton(SDL_Joy, B)) and (JoyUnit.Button[B].State = 0) then begin
- JoyEvent.type_ := JoyUnit.Button[B].Type_;
- JoyEvent.key.keysym.sym := JoyUnit.Button[B].Sym;
- SDL_PushEvent(@JoyEvent);
- end;
- end;
-
-
- for B := 0 to 15 do begin
- JoyUnit.Button[B].State := SDL_JoystickGetButton(SDL_Joy, B);
- end;
-
- //Get Tick
- Tick := SDL_GetTicks();
-
- //Get CoolieHat
- if (SDL_JoystickNumHats(SDL_Joy)>=1) then
- State := SDL_JoystickGetHat(SDL_Joy, 0)
- else
- State := 0;
-
- //Get Axis
- if (SDL_JoystickNumAxes(SDL_Joy)>=2) then
- begin
- //Down - Up (X- Axis)
- Axes := SDL_JoystickGetAxis(SDL_Joy, 1);
- If Axes >= 15000 then
- State := State or SDL_HAT_Down
- Else If Axes <= -15000 then
- State := State or SDL_HAT_UP;
-
- //Left - Right (Y- Axis)
- Axes := SDL_JoystickGetAxis(SDL_Joy, 0);
- If Axes >= 15000 then
- State := State or SDL_HAT_Right
- Else If Axes <= -15000 then
- State := State or SDL_HAT_Left;
- end;
-
- //Manage Hat and joystick Events
- if (SDL_JoystickNumHats(SDL_Joy)>=1) OR (SDL_JoystickNumAxes(SDL_Joy)>=2) then
- begin
-
- //Up Button
- If (JoyUnit.HatState[0].Enabled) and ((SDL_HAT_UP AND State) = SDL_HAT_UP) then
- begin //IF Button is newly Pressed or if he is Pressed longer than 500 msecs
- if (JoyUnit.HatState[0].State = False) OR (JoyUnit.HatState[0].Lasttick < Tick) then
- begin
- //Set Tick and State
- if JoyUnit.HatState[0].State then
- JoyUnit.HatState[0].Lasttick := Tick + 200
- else
- JoyUnit.HatState[0].Lasttick := Tick + 500;
-
- JoyUnit.HatState[0].State := True;
-
- JoyEvent.type_ := JoyUnit.HatState[0].Type_;
- JoyEvent.key.keysym.sym := JoyUnit.HatState[0].Sym;
- SDL_PushEvent(@JoyEvent);
- end;
- end
- else
- JoyUnit.HatState[0].State := False;
-
- //Right Button
- If (JoyUnit.HatState[1].Enabled) and ((SDL_HAT_RIGHT AND State) = SDL_HAT_RIGHT) then
- begin //IF Button is newly Pressed or if he is Pressed longer than 500 msecs
- if (JoyUnit.HatState[1].State = False) OR (JoyUnit.HatState[1].Lasttick < Tick) then
- begin
- //Set Tick and State
- if JoyUnit.HatState[1].State then
- JoyUnit.HatState[1].Lasttick := Tick + 200
- else
- JoyUnit.HatState[1].Lasttick := Tick + 500;
-
- JoyUnit.HatState[1].State := True;
-
- JoyEvent.type_ := JoyUnit.HatState[1].Type_;
- JoyEvent.key.keysym.sym := JoyUnit.HatState[1].Sym;
- SDL_PushEvent(@JoyEvent);
- end;
- end
- else
- JoyUnit.HatState[1].State := False;
-
- //Down button
- If (JoyUnit.HatState[2].Enabled) and ((SDL_HAT_DOWN AND State) = SDL_HAT_DOWN) then
- begin //IF Button is newly Pressed or if he is Pressed longer than 230 msecs
- if (JoyUnit.HatState[2].State = False) OR (JoyUnit.HatState[2].Lasttick < Tick) then
- begin
- //Set Tick and State
- if JoyUnit.HatState[2].State then
- JoyUnit.HatState[2].Lasttick := Tick + 200
- else
- JoyUnit.HatState[2].Lasttick := Tick + 500;
-
- JoyUnit.HatState[2].State := True;
-
- JoyEvent.type_ := JoyUnit.HatState[2].Type_;
- JoyEvent.key.keysym.sym := JoyUnit.HatState[2].Sym;
- SDL_PushEvent(@JoyEvent);
- end;
- end
- else
- JoyUnit.HatState[2].State := False;
-
- //Left Button
- If (JoyUnit.HatState[3].Enabled) and ((SDL_HAT_LEFT AND State) = SDL_HAT_LEFT) then
- begin //IF Button is newly Pressed or if he is Pressed longer than 230 msecs
- if (JoyUnit.HatState[3].State = False) OR (JoyUnit.HatState[3].Lasttick < Tick) then
- begin
- //Set Tick and State
- if JoyUnit.HatState[3].State then
- JoyUnit.HatState[3].Lasttick := Tick + 200
- else
- JoyUnit.HatState[3].Lasttick := Tick + 500;
-
- JoyUnit.HatState[3].State := True;
-
- JoyEvent.type_ := JoyUnit.HatState[3].Type_;
- JoyEvent.key.keysym.sym := JoyUnit.HatState[3].Sym;
- SDL_PushEvent(@JoyEvent);
- end;
- end
- else
- JoyUnit.HatState[3].State := False;
- end;
-
-end;
-
-end.
diff --git a/src/base/ULog.pas b/src/base/ULog.pas
deleted file mode 100644
index e4ff4862..00000000
--- a/src/base/ULog.pas
+++ /dev/null
@@ -1,441 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit ULog;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- Classes,
- UPath;
-
-(*
- * LOG_LEVEL_[TYPE] defines the "minimum" index for logs of type TYPE. Each
- * level greater than this BUT less or equal than LOG_LEVEL_[TYPE]_MAX is of this type.
- * This means a level "LOG_LEVEL_ERROR >= Level <= LOG_LEVEL_ERROR_MAX" e.g.
- * "Level := LOG_LEVEL_ERROR+2" is considered an error level.
- * This is nice for debugging if you have more or less important debug messages.
- * For example you can assign LOG_LEVEL_DEBUG+10 for the more important ones and
- * LOG_LEVEL_DEBUG+20 for less important ones and so on. By changing the log-level
- * you can hide the less important ones.
- *)
-const
- LOG_LEVEL_DEBUG_MAX = MaxInt;
- LOG_LEVEL_DEBUG = 50;
- LOG_LEVEL_INFO_MAX = LOG_LEVEL_DEBUG-1;
- LOG_LEVEL_INFO = 40;
- LOG_LEVEL_STATUS_MAX = LOG_LEVEL_INFO-1;
- LOG_LEVEL_STATUS = 30;
- LOG_LEVEL_WARN_MAX = LOG_LEVEL_STATUS-1;
- LOG_LEVEL_WARN = 20;
- LOG_LEVEL_ERROR_MAX = LOG_LEVEL_WARN-1;
- LOG_LEVEL_ERROR = 10;
- LOG_LEVEL_CRITICAL_MAX = LOG_LEVEL_ERROR-1;
- LOG_LEVEL_CRITICAL = 0;
- LOG_LEVEL_NONE = -1;
-
- // define level that Log(File)Level is initialized with
- LOG_LEVEL_DEFAULT = LOG_LEVEL_WARN;
- LOG_FILE_LEVEL_DEFAULT = LOG_LEVEL_ERROR;
-
-type
- TLog = class
- private
- LogFile: TextFile;
- LogFileOpened: boolean;
- BenchmarkFile: TextFile;
- BenchmarkFileOpened: boolean;
-
- LogLevel: integer;
- // level of messages written to the log-file
- LogFileLevel: integer;
-
- procedure LogToFile(const Text: string);
- public
- BenchmarkTimeStart: array[0..31] of real;
- BenchmarkTimeLength: array[0..31] of real;//TDateTime;
-
- Title: String; //Application Title
-
- // Write log message to log-file
- FileOutputEnabled: Boolean;
-
- constructor Create;
-
- // destuctor
- destructor Destroy; override;
-
- // benchmark
- procedure BenchmarkStart(Number: integer);
- procedure BenchmarkEnd(Number: integer);
- procedure LogBenchmark(const Text: string; Number: integer);
-
- procedure SetLogLevel(Level: integer);
- function GetLogLevel(): integer;
-
- procedure LogMsg(const Text: string; Level: integer); overload;
- procedure LogMsg(const Msg, Context: string; Level: integer); overload; {$IFDEF HasInline}inline;{$ENDIF}
- procedure LogDebug(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF}
- procedure LogInfo(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF}
- procedure LogStatus(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF}
- procedure LogWarn(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF}
- procedure LogError(const Text: string); overload; {$IFDEF HasInline}inline;{$ENDIF}
- procedure LogError(const Msg, Context: string); overload; {$IFDEF HasInline}inline;{$ENDIF}
- //Critical Error (Halt + MessageBox)
- procedure LogCritical(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF}
- procedure CriticalError(const Text: string); {$IFDEF HasInline}inline;{$ENDIF}
-
- // voice
- procedure LogVoice(SoundNr: integer);
- // buffer
- procedure LogBuffer(const buf : Pointer; const bufLength : Integer; const filename : IPath);
- end;
-
-procedure DebugWriteln(const aString: String);
-
-var
- Log: TLog;
-
-implementation
-
-uses
- SysUtils,
- DateUtils,
- URecord,
- UMain,
- UTime,
- UCommon,
- UCommandLine,
- UPathUtils;
-
-(*
- * Write to console if in debug mode (Thread-safe).
- * If debug-mode is disabled nothing is done.
- *)
-procedure DebugWriteln(const aString: string);
-begin
- {$IFNDEF DEBUG}
- if Params.Debug then
- begin
- {$ENDIF}
- ConsoleWriteLn(aString);
- {$IFNDEF DEBUG}
- end;
- {$ENDIF}
-end;
-
-
-constructor TLog.Create;
-begin
- inherited;
- LogLevel := LOG_LEVEL_DEFAULT;
- LogFileLevel := LOG_FILE_LEVEL_DEFAULT;
- FileOutputEnabled := true;
-end;
-
-destructor TLog.Destroy;
-begin
- if BenchmarkFileOpened then
- CloseFile(BenchmarkFile);
- //if AnalyzeFileOpened then
- // CloseFile(AnalyzeFile);
- if LogFileOpened then
- CloseFile(LogFile);
- inherited;
-end;
-
-procedure TLog.BenchmarkStart(Number: integer);
-begin
- BenchmarkTimeStart[Number] := USTime.GetTime; //Time;
-end;
-
-procedure TLog.BenchmarkEnd(Number: integer);
-begin
- BenchmarkTimeLength[Number] := USTime.GetTime {Time} - BenchmarkTimeStart[Number];
-end;
-
-procedure TLog.LogBenchmark(const Text: string; Number: integer);
-var
- Minutes: integer;
- Seconds: integer;
- Miliseconds: integer;
-
- MinutesS: string;
- SecondsS: string;
- MilisecondsS: string;
-
- ValueText: string;
-begin
- if (FileOutputEnabled and Params.Benchmark) then
- begin
- if not BenchmarkFileOpened then
- begin
- BenchmarkFileOpened := true;
- AssignFile(BenchmarkFile, LogPath.Append('Benchmark.log').ToNative);
- {$I-}
- Rewrite(BenchmarkFile);
- if IOResult = 0 then
- BenchmarkFileOpened := true;
- {$I+}
-
- //If File is opened write Date to Benchmark File
- If (BenchmarkFileOpened) then
- begin
- WriteLn(BenchmarkFile, Title + ' Benchmark File');
- WriteLn(BenchmarkFile, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now));
- WriteLn(BenchmarkFile, '-------------------');
-
- Flush(BenchmarkFile);
- end;
- end;
-
- if BenchmarkFileOpened then
- begin
- Miliseconds := Trunc(Frac(BenchmarkTimeLength[Number]) * 1000);
- Seconds := Trunc(BenchmarkTimeLength[Number]) mod 60;
- Minutes := Trunc((BenchmarkTimeLength[Number] - Seconds) / 60);
- //ValueText := FloatToStr(BenchmarkTimeLength[Number]);
-
- {
- ValueText := FloatToStr(SecondOf(BenchmarkTimeLength[Number]) +
- MilliSecondOf(BenchmarkTimeLength[Number])/1000);
- if MinuteOf(BenchmarkTimeLength[Number]) >= 1 then
- ValueText := IntToStr(MinuteOf(BenchmarkTimeLength[Number])) + ':' + ValueText;
- WriteLn(FileBenchmark, Text + ': ' + ValueText + ' seconds');
- }
-
- if (Minutes = 0) and (Seconds = 0) then begin
- MilisecondsS := IntToStr(Miliseconds);
- ValueText := MilisecondsS + ' miliseconds';
- end;
-
- if (Minutes = 0) and (Seconds >= 1) then begin
- MilisecondsS := IntToStr(Miliseconds);
- while Length(MilisecondsS) < 3 do
- MilisecondsS := '0' + MilisecondsS;
-
- SecondsS := IntToStr(Seconds);
-
- ValueText := SecondsS + ',' + MilisecondsS + ' seconds';
- end;
-
- if Minutes >= 1 then begin
- MilisecondsS := IntToStr(Miliseconds);
- while Length(MilisecondsS) < 3 do
- MilisecondsS := '0' + MilisecondsS;
-
- SecondsS := IntToStr(Seconds);
- while Length(SecondsS) < 2 do
- SecondsS := '0' + SecondsS;
-
- MinutesS := IntToStr(Minutes);
-
- ValueText := MinutesS + ':' + SecondsS + ',' + MilisecondsS + ' minutes';
- end;
-
- WriteLn(BenchmarkFile, Text + ': ' + ValueText);
- Flush(BenchmarkFile);
- end;
- end;
-end;
-
-procedure TLog.LogToFile(const Text: string);
-begin
- if (FileOutputEnabled and not LogFileOpened) then
- begin
- AssignFile(LogFile, LogPath.Append('Error.log').ToNative);
- {$I-}
- Rewrite(LogFile);
- if IOResult = 0 then
- LogFileOpened := true;
- {$I+}
-
- //If File is opened write Date to Error File
- if (LogFileOpened) then
- begin
- WriteLn(LogFile, Title + ' Error Log');
- WriteLn(LogFile, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now));
- WriteLn(LogFile, '-------------------');
-
- Flush(LogFile);
- end;
- end;
-
- if LogFileOpened then
- begin
- try
- WriteLn(LogFile, Text);
- Flush(LogFile);
- except
- LogFileOpened := false;
- end;
- end;
-end;
-
-procedure TLog.SetLogLevel(Level: integer);
-begin
- LogLevel := Level;
-end;
-
-function TLog.GetLogLevel(): integer;
-begin
- Result := LogLevel;
-end;
-
-procedure TLog.LogMsg(const Text: string; Level: integer);
-var
- LogMsg: string;
-begin
- // TODO: what if (LogFileLevel < LogLevel)? Log to file without printing to
- // console or do not log at all? At the moment nothing is logged.
- if (Level <= LogLevel) then
- begin
- if (Level <= LOG_LEVEL_CRITICAL_MAX) then
- LogMsg := 'CRITICAL: ' + Text
- else if (Level <= LOG_LEVEL_ERROR_MAX) then
- LogMsg := 'ERROR: ' + Text
- else if (Level <= LOG_LEVEL_WARN_MAX) then
- LogMsg := 'WARN: ' + Text
- else if (Level <= LOG_LEVEL_STATUS_MAX) then
- LogMsg := 'STATUS: ' + Text
- else if (Level <= LOG_LEVEL_INFO_MAX) then
- LogMsg := 'INFO: ' + Text
- else
- LogMsg := 'DEBUG: ' + Text;
-
- // output log-message
- if (Level <= LogLevel) then
- begin
- DebugWriteLn(LogMsg);
- end;
-
- // write message to log-file
- if (Level <= LogFileLevel) then
- begin
- LogToFile(LogMsg);
- end;
- end;
-
- // exit application on criticial errors (cannot be turned off)
- if (Level <= LOG_LEVEL_CRITICAL_MAX) then
- begin
- // Show information (window)
- ShowMessage(Text, mtError);
- Halt;
- end;
-end;
-
-procedure TLog.LogMsg(const Msg, Context: string; Level: integer);
-begin
- LogMsg(Msg + ' ['+Context+']', Level);
-end;
-
-procedure TLog.LogDebug(const Msg, Context: string);
-begin
- LogMsg(Msg, Context, LOG_LEVEL_DEBUG);
-end;
-
-procedure TLog.LogInfo(const Msg, Context: string);
-begin
- LogMsg(Msg, Context, LOG_LEVEL_INFO);
-end;
-
-procedure TLog.LogStatus(const Msg, Context: string);
-begin
- LogMsg(Msg, Context, LOG_LEVEL_STATUS);
-end;
-
-procedure TLog.LogWarn(const Msg, Context: string);
-begin
- LogMsg(Msg, Context, LOG_LEVEL_WARN);
-end;
-
-procedure TLog.LogError(const Msg, Context: string);
-begin
- LogMsg(Msg, Context, LOG_LEVEL_ERROR);
-end;
-
-procedure TLog.LogError(const Text: string);
-begin
- LogMsg(Text, LOG_LEVEL_ERROR);
-end;
-
-procedure TLog.CriticalError(const Text: string);
-begin
- LogMsg(Text, LOG_LEVEL_CRITICAL);
-end;
-
-procedure TLog.LogCritical(const Msg, Context: string);
-begin
- LogMsg(Msg, Context, LOG_LEVEL_CRITICAL);
-end;
-
-procedure TLog.LogVoice(SoundNr: integer);
-var
- FS: TBinaryFileStream;
- Prefix: string;
- FileName: IPath;
- Num: integer;
-begin
- for Num := 1 to 9999 do begin
- Prefix := Format('Voice%.4d', [Num]);
- FileName := LogPath.Append(Prefix + '.raw');
- if not FileName.Exists() then
- break
- end;
-
- FS := TBinaryFileStream.Create(FileName, fmCreate);
-
- AudioInputProcessor.Sound[SoundNr].LogBuffer.Seek(0, soBeginning);
- FS.CopyFrom(AudioInputProcessor.Sound[SoundNr].LogBuffer, AudioInputProcessor.Sound[SoundNr].LogBuffer.Size);
-
- FS.Free;
-end;
-
-procedure TLog.LogBuffer(const buf: Pointer; const bufLength: Integer; const filename: IPath);
-var
- f : TBinaryFileStream;
-begin
- try
- f := TBinaryFileStream.Create( filename, fmCreate);
- try
- f.Write( buf^, bufLength);
- finally
- f.Free;
- end;
- except on e : Exception do
- Log.LogError('TLog.LogBuffer: Failed to log buffer into file "' + filename.ToNative + '". ErrMsg: ' + e.Message);
- end;
-end;
-
-end.
-
-
diff --git a/src/base/ULyrics.pas b/src/base/ULyrics.pas
deleted file mode 100644
index 3f62db9c..00000000
--- a/src/base/ULyrics.pas
+++ /dev/null
@@ -1,726 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit ULyrics;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- gl,
- glext,
- UTexture,
- UThemes,
- UMusic;
-
-type
- // stores two textures for enabled/disabled states
- TPlayerIconTex = array [0..1] of TTexture;
-
- TLyricsEffect = (lfxSimple, lfxZoom, lfxSlide, lfxBall, lfxShift);
-
- PLyricWord = ^TLyricWord;
- TLyricWord = record
- X: real; // left corner
- Width: real; // width
- Start: cardinal; // start of the word in quarters (beats)
- Length: cardinal; // length of the word in quarters
- Text: UTF8String; // text
- Freestyle: boolean; // is freestyle?
- end;
- TLyricWordArray = array of TLyricWord;
-
- TLyricLine = class
- public
- Text: UTF8String; // text
- Width: real; // width
- Height: real; // height
- Words: TLyricWordArray; // words in this line
- CurWord: integer; // current active word idx (only valid if line is active)
- Start: integer; // start of this line in quarters (Note: negative start values are possible due to gap)
- StartNote: integer; // start of the first note of this line in quarters
- Length: integer; // length in quarters (from start of first to the end of the last note)
- Players: byte; // players that should sing that line (bitset, Player1: 1, Player2: 2, Player3: 4)
- LastLine: boolean; // is this the last line of the song?
-
- constructor Create();
- destructor Destroy(); override;
- procedure Reset();
- end;
-
- TLyricEngine = class
- private
- LastDrawBeat: real;
- UpperLine: TLyricLine; // first line displayed (top)
- LowerLine: TLyricLine; // second lind displayed (bottom)
- QueueLine: TLyricLine; // third line (will be displayed when lower line is finished)
-
- IndicatorTex: TTexture; // texture for lyric indikator
- BallTex: TTexture; // texture of the ball for the lyric effect
-
- QueueFull: boolean; // set to true if the queue is full and a line will be replaced with the next AddLine
- LCounter: integer; // line counter
-
- // duet mode - textures for player icons
- // FIXME: do not use a fixed player count, use MAX_PLAYERS instead
- PlayerIconTex: array[0..5] of TPlayerIconTex;
-
- // Some helper procedures for lyric drawing
- procedure DrawLyrics (Beat: real);
- procedure UpdateLineMetrics(LyricLine: TLyricLine);
- procedure DrawLyricsWords(LyricLine: TLyricLine; X, Y: real; StartWord, EndWord: integer);
- procedure DrawLyricsLine(X, W, Y, H: real; Line: TLyricLine; Beat: real);
- procedure DrawPlayerIcon(Player: byte; Enabled: boolean; X, Y: real; Size, Alpha: real);
- procedure DrawBall(XBall, YBall, Alpha: real);
-
- public
- // positions, line specific settings
- UpperLineX: real; // X start-pos of UpperLine
- UpperLineW: real; // Width of UpperLine with icon(s) and text
- UpperLineY: real; // Y start-pos of UpperLine
- UpperLineH: real; // Max. font-size of lyrics text in UpperLine
-
- LowerLineX: real; // X start-pos of LowerLine
- LowerLineW: real; // Width of LowerLine with icon(s) and text
- LowerLineY: real; // Y start-pos of LowerLine
- LowerLineH: real; // Max. font-size of lyrics text in LowerLine
-
- // display propertys
- LineColor_en: TRGBA; // Color of words in an enabled line
- LineColor_dis: TRGBA; // Color of words in a disabled line
- LineColor_act: TRGBA; // Color of the active word
- FontStyle: byte; // Font for the lyric text
-
- { // currently not used
- FadeInEffect: byte; // Effect for line fading in: 0: No Effect; 1: Fade Effect; 2: Move Upwards from Bottom to Pos
- FadeOutEffect: byte; // Effect for line fading out: 0: No Effect; 1: Fade Effect; 2: Move Upwards
- }
-
- // song specific settings
- BPM: real;
- Resolution: integer;
-
- // properties to easily read options of this class
- property IsQueueFull: boolean read QueueFull; // line in queue?
- property LineCounter: integer read LCounter; // lines that were progressed so far (after last clear)
-
- procedure AddLine(Line: PLine); // adds a line to the queue, if there is space
- procedure Draw (Beat: real); // draw the current (active at beat) lyrics
-
- // clears all cached song specific information
- procedure Clear(cBPM: real = 0; cResolution: integer = 0);
-
- function GetUpperLine(): TLyricLine;
- function GetLowerLine(): TLyricLine;
-
- function GetUpperLineIndex(): integer;
-
- constructor Create(ULX, ULY, ULW, ULH, LLX, LLY, LLW, LLH: real);
- procedure LoadTextures;
- destructor Destroy; override;
- end;
-
-implementation
-
-uses
- SysUtils,
- USkins,
- TextGL,
- UGraphic,
- UDisplay,
- ULog,
- math,
- UIni;
-
-{ TLyricLine }
-
-constructor TLyricLine.Create();
-begin
- inherited;
- Reset();
-end;
-
-destructor TLyricLine.Destroy();
-begin
- SetLength(Words, 0);
- inherited;
-end;
-
-procedure TLyricLine.Reset();
-begin
- Start := 0;
- StartNote := 0;
- Length := 0;
- LastLine := False;
-
- Text := '';
- Width := 0;
-
- // duet mode: players of that line (default: all)
- Players := $FF;
-
- SetLength(Words, 0);
- CurWord := -1;
-end;
-
-
-{ TLyricEngine }
-
-{**
- * Initializes the engine.
- *}
-constructor TLyricEngine.Create(ULX, ULY, ULW, ULH, LLX, LLY, LLW, LLH: real);
-begin
- inherited Create();
-
- BPM := 0;
- Resolution := 0;
- LCounter := 0;
- QueueFull := False;
-
- UpperLine := TLyricLine.Create;
- LowerLine := TLyricLine.Create;
- QueueLine := TLyricLine.Create;
-
- LastDrawBeat := 0;
-
- UpperLineX := ULX;
- UpperLineW := ULW;
- UpperLineY := ULY;
- UpperLineH := ULH;
-
- LowerLineX := LLX;
- LowerLineW := LLW;
- LowerLineY := LLY;
- LowerLineH := LLH;
-
- LoadTextures;
-end;
-
-
-{**
- * Frees memory.
- *}
-destructor TLyricEngine.Destroy;
-begin
- UpperLine.Free;
- LowerLine.Free;
- QueueLine.Free;
- inherited;
-end;
-
-{**
- * Clears all cached Song specific Information.
- *}
-procedure TLyricEngine.Clear(cBPM: real; cResolution: integer);
-begin
- BPM := cBPM;
- Resolution := cResolution;
- LCounter := 0;
- QueueFull := False;
-
- LastDrawBeat:=0;
-end;
-
-
-{**
- * Loads textures needed for the drawing the lyrics,
- * player icons, a ball for the ball effect and the lyric indicator.
- *}
-procedure TLyricEngine.LoadTextures;
-var
- I: Integer;
-begin
- // lyric indicator (bar that indicates when the line start)
- IndicatorTex := Texture.LoadTexture(Skin.GetTextureFileName('LyricHelpBar'), TEXTURE_TYPE_TRANSPARENT, $FF00FF);
-
- // ball for current word hover in ball effect
- BallTex := Texture.LoadTexture(Skin.GetTextureFileName('Ball'), TEXTURE_TYPE_TRANSPARENT, 0);
-
- // duet mode: load player icon
- for I := 0 to 5 do
- begin
- PlayerIconTex[I][0] := Texture.LoadTexture(Skin.GetTextureFileName('LyricIcon_P' + InttoStr(I+1)), TEXTURE_TYPE_TRANSPARENT, 0);
- PlayerIconTex[I][1] := Texture.LoadTexture(Skin.GetTextureFileName('LyricIconD_P' + InttoStr(I+1)), TEXTURE_TYPE_TRANSPARENT, 0);
- end;
-end;
-
-{**
- * Adds LyricLine to queue.
- * The LyricEngine stores three lines in its queue:
- * UpperLine: the upper line displayed in the lyrics
- * LowerLine: the lower line displayed in the lyrics
- * QueueLine: an offscreen line that precedes LowerLine
- * If the queue is full the next call to AddLine will replace UpperLine with
- * LowerLine, LowerLine with QueueLine and QueueLine with the Line parameter.
- *}
-procedure TLyricEngine.AddLine(Line: PLine);
-var
- LyricLine: TLyricLine;
- I: integer;
-begin
- // only add lines, if there is space
- if not IsQueueFull then
- begin
- // set LyricLine to line to write to
- if (LineCounter = 0) then
- LyricLine := UpperLine
- else if (LineCounter = 1) then
- LyricLine := LowerLine
- else
- begin
- // now the queue is full
- LyricLine := QueueLine;
- QueueFull := True;
- end;
- end
- else
- begin // rotate lines (round-robin-like)
- LyricLine := UpperLine;
- UpperLine := LowerLine;
- LowerLine := QueueLine;
- QueueLine := LyricLine;
- end;
-
- // reset line state
- LyricLine.Reset();
-
- // check if sentence has notes
- if (Line <> nil) and (Length(Line.Note) > 0) then
- begin
- // copy values from SongLine to LyricLine
- LyricLine.Start := Line.Start;
- LyricLine.StartNote := Line.Note[0].Start;
- LyricLine.Length := Line.Note[High(Line.Note)].Start +
- Line.Note[High(Line.Note)].Length -
- Line.Note[0].Start;
- LyricLine.LastLine := Line.LastLine;
-
- // copy words
- SetLength(LyricLine.Words, Length(Line.Note));
- for I := 0 to High(Line.Note) do
- begin
- LyricLine.Words[I].Start := Line.Note[I].Start;
- LyricLine.Words[I].Length := Line.Note[I].Length;
- LyricLine.Words[I].Text := Line.Note[I].Text;
- LyricLine.Words[I].Freestyle := Line.Note[I].NoteType = ntFreestyle;
-
- LyricLine.Text := LyricLine.Text + LyricLine.Words[I].Text;
- end;
-
- UpdateLineMetrics(LyricLine);
- end;
-
- // increase the counter
- Inc(LCounter);
-end;
-
-{**
- * Draws Lyrics.
- * Draw just manages the Lyrics, drawing is done by a call of DrawLyrics.
- * @param Beat: current Beat in Quarters
- *}
-procedure TLyricEngine.Draw(Beat: real);
-begin
- DrawLyrics(Beat);
- LastDrawBeat := Beat;
-end;
-
-{**
- * Main Drawing procedure.
- *}
-procedure TLyricEngine.DrawLyrics(Beat: real);
-begin
- DrawLyricsLine(UpperLineX, UpperLineW, UpperLineY, UpperLineH, UpperLine, Beat);
- DrawLyricsLine(LowerLineX, LowerLineW, LowerLineY, LowerLineH, LowerLine, Beat);
-end;
-
-{**
- * Draws a Player's icon.
- *}
-procedure TLyricEngine.DrawPlayerIcon(Player: byte; Enabled: boolean; X, Y: real; Size, Alpha: real);
-var
- IEnabled: byte;
-begin
- if Enabled then
- IEnabled := 0
- else
- IEnabled := 1;
-
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glBindTexture(GL_TEXTURE_2D, PlayerIconTex[Player][IEnabled].TexNum);
-
- glColor4f(1, 1, 1, Alpha);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(X, Y);
- glTexCoord2f(0, 1); glVertex2f(X, Y + Size);
- glTexCoord2f(1, 1); glVertex2f(X + Size, Y + Size);
- glTexCoord2f(1, 0); glVertex2f(X + Size, Y);
- glEnd;
-
- glDisable(GL_BLEND);
- glDisable(GL_TEXTURE_2D);
-end;
-
-{**
- * Draws the Ball over the LyricLine if needed.
- *}
-procedure TLyricEngine.DrawBall(XBall, YBall, Alpha: real);
-begin
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glBindTexture(GL_TEXTURE_2D, BallTex.TexNum);
-
- glColor4f(1, 1, 1, Alpha);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(XBall - 10, YBall);
- glTexCoord2f(0, 1); glVertex2f(XBall - 10, YBall + 20);
- glTexCoord2f(1, 1); glVertex2f(XBall + 10, YBall + 20);
- glTexCoord2f(1, 0); glVertex2f(XBall + 10, YBall);
- glEnd;
-
- glDisable(GL_BLEND);
- glDisable(GL_TEXTURE_2D);
-end;
-
-procedure TLyricEngine.DrawLyricsWords(LyricLine: TLyricLine;
- X, Y: real; StartWord, EndWord: integer);
-var
- I: integer;
- PosX: real;
- CurWord: PLyricWord;
-begin
- PosX := X;
-
- // set word positions and line size and draw the line
- for I := StartWord to EndWord do
- begin
- CurWord := @LyricLine.Words[I];
- SetFontItalic(CurWord.Freestyle);
- SetFontPos(PosX, Y);
- glPrint(CurWord.Text);
- PosX := PosX + CurWord.Width;
- end;
-end;
-
-procedure TLyricEngine.UpdateLineMetrics(LyricLine: TLyricLine);
-var
- I: integer;
- PosX: real;
- CurWord: PLyricWord;
- RequestWidth, RequestHeight: real;
-begin
- PosX := 0;
-
- // setup font
- SetFontStyle(FontStyle);
- ResetFont();
-
- // check if line is lower or upper line and set sizes accordingly
- // Note: at the moment upper and lower lines have same width/height
- // and this function is just called by AddLine() but this may change
- // so that it is called by DrawLyricsLine().
- //if (LyricLine = LowerLine) then
- //begin
- // RequestWidth := LowerLineW;
- // RequestHeight := LowerLineH;
- //end
- //else
- //begin
- RequestWidth := UpperLineW;
- RequestHeight := UpperLineH;
- //end;
-
- // set font size to a reasonable value
- LyricLine.Height := RequestHeight * 0.9;
- SetFontSize(LyricLine.Height);
- LyricLine.Width := glTextWidth(LyricLine.Text);
-
- // change font-size to fit into the lyric bar
- if (LyricLine.Width > RequestWidth) then
- begin
- LyricLine.Height := Trunc(LyricLine.Height * (RequestWidth / LyricLine.Width));
- // the line is very loooong, set font to at least 1px
- if (LyricLine.Height < 1) then
- LyricLine.Height := 1;
-
- SetFontSize(LyricLine.Height);
- LyricLine.Width := glTextWidth(LyricLine.Text);
- end;
-
- // calc word positions and widths
- for I := 0 to High(LyricLine.Words) do
- begin
- CurWord := @LyricLine.Words[I];
-
- // - if current word is italic but not the next word get the width of the
- // italic font to avoid overlapping.
- // - if two italic words follow each other use the normal style's
- // width otherwise the spacing between the words will be too big.
- // - if it is the line's last word use normal width
- if CurWord.Freestyle and
- (I+1 < Length(LyricLine.Words)) and
- (not LyricLine.Words[I+1].Freestyle) then
- begin
- SetFontItalic(true);
- end;
-
- CurWord.X := PosX;
- CurWord.Width := glTextWidth(CurWord.Text);
- PosX := PosX + CurWord.Width;
- SetFontItalic(false);
- end;
-end;
-
-
-{**
- * Draws one LyricLine
- *}
-procedure TLyricEngine.DrawLyricsLine(X, W, Y, H: real; Line: TLyricLine; Beat: real);
-var
- CurWord: PLyricWord; // current word
- LastWord: PLyricWord; // last word in line
- NextWord: PLyricWord; // word following current word
- Progress: real; // progress of singing the current word
- LyricX, LyricY: real; // left/top lyric position
- WordY: real; // word y-position
- LyricsEffect: TLyricsEffect;
- Alpha: real; // alphalevel to fade out at end
- ClipPlaneEq: array[0..3] of GLdouble; // clipping plane for slide effect
- {// duet mode
- IconSize: real; // size of player icons
- IconAlpha: real; // alpha level of player icons
- }
-begin
- // do not draw empty lines
- if (Length(Line.Words) = 0) then
- Exit;
-
- {
- // duet mode
- IconSize := (2 * Height);
- IconAlpha := Frac(Beat/(Resolution*4));
-
- DrawPlayerIcon (0, True, X, Y + (42 - IconSize) / 2 , IconSize, IconAlpha);
- DrawPlayerIcon (1, True, X + IconSize + 1, Y + (42 - IconSize) / 2, IconSize, IconAlpha);
- DrawPlayerIcon (2, True, X + (IconSize + 1)*2, Y + (42 - IconSize) / 2, IconSize, IconAlpha);
- }
-
- // set font size and style
- SetFontStyle(FontStyle);
- ResetFont();
- SetFontSize(Line.Height);
-
- // center lyrics
- LyricX := X + (W - Line.Width) / 2;
- LyricY := Y + (H - Line.Height) / 2;
- // get lyrics effect
- LyricsEffect := TLyricsEffect(Ini.LyricsEffect);
-
- // TODO: what about alpha in freetype outline fonts?
- Alpha := 1;
-
- // check if this line is active (at least its first note must be active)
- if (Beat >= Line.StartNote) then
- begin
- // if this line just got active, CurWord is -1,
- // this means we should try to make the first word active
- if (Line.CurWord = -1) then
- Line.CurWord := 0;
-
- // check if the current active word is still active.
- // Otherwise proceed to the next word if there is one in this line.
- // Note: the max. value of Line.CurWord is High(Line.Words)
- if (Line.CurWord < High(Line.Words)) and
- (Beat >= Line.Words[Line.CurWord + 1].Start) then
- begin
- Inc(Line.CurWord);
- end;
-
- // determine current and last word in this line.
- // If the end of the line is reached use the last word as current word.
- LastWord := @Line.Words[High(Line.Words)];
- CurWord := @Line.Words[Line.CurWord];
- if (Line.CurWord+1 < Length(Line.Words)) then
- NextWord := @Line.Words[Line.CurWord+1]
- else
- NextWord := nil;
-
- // calc the progress of the lyrics effect
- Progress := (Beat - CurWord.Start) / CurWord.Length;
- if (Progress >= 1) then
- Progress := 1;
- if (Progress <= 0) then
- Progress := 0;
-
- // last word of this line finished, but this line did not hide -> fade out
- if Line.LastLine and
- (Beat > LastWord.Start + LastWord.Length) then
- begin
- Alpha := 1 - (Beat - (LastWord.Start + LastWord.Length)) / 15;
- if (Alpha < 0) then
- Alpha := 0;
- end;
-
- // draw sentence before current word
- if (LyricsEffect in [lfxSimple, lfxBall, lfxShift]) then
- // only highlight current word and not that ones before in this line
- glColorRGB(LineColor_en, Alpha)
- else
- glColorRGB(LineColor_act, Alpha);
- DrawLyricsWords(Line, LyricX, LyricY, 0, Line.CurWord-1);
-
- // draw rest of sentence (without current word)
- glColorRGB(LineColor_en, Alpha);
- if (NextWord <> nil) then
- begin
- DrawLyricsWords(Line, LyricX + NextWord.X, LyricY,
- Line.CurWord+1, High(Line.Words));
- end;
-
- // draw current word
- if (LyricsEffect in [lfxSimple, lfxBall, lfxShift]) then
- begin
- if (LyricsEffect = lfxShift) then
- WordY := LyricY - 8 * (1-Progress)
- else
- WordY := LyricY;
-
- // change the color of the current word
- glColor4f(LineColor_act.r, LineColor_act.g, LineColor_act.b, Alpha);
- DrawLyricsWords(Line, LyricX + CurWord.X, WordY, Line.CurWord, Line.CurWord);
- end
- // change color and zoom current word
- else if (LyricsEffect = lfxZoom) then
- begin
- glPushMatrix;
-
- // zoom at word center
- glTranslatef(LyricX + CurWord.X + CurWord.Width/2,
- LyricY + Line.Height/2, 0);
- glScalef(1.0 + (1-Progress) * 0.5, 1.0 + (1-Progress) * 0.5, 1.0);
-
- glColor4f(LineColor_act.r, LineColor_act.g, LineColor_act.b, Alpha);
- DrawLyricsWords(Line, -CurWord.Width/2, -Line.Height/2, Line.CurWord, Line.CurWord);
-
- glPopMatrix;
- end
- // split current word into active and non-active part
- else if (LyricsEffect = lfxSlide) then
- begin
- // enable clipping and set clip equation coefficients to zeros
- glEnable(GL_CLIP_PLANE0);
- FillChar(ClipPlaneEq[0], SizeOf(ClipPlaneEq), 0);
-
- glPushMatrix;
- glTranslatef(LyricX + CurWord.X, LyricY, 0);
-
- // clip non-active right part of the current word
- ClipPlaneEq[0] := -1;
- ClipPlaneEq[3] := CurWord.Width * Progress;
- glClipPlane(GL_CLIP_PLANE0, @ClipPlaneEq);
- // and draw active left part
- glColor4f(LineColor_act.r, LineColor_act.g, LineColor_act.b, Alpha);
- DrawLyricsWords(Line, 0, 0, Line.CurWord, Line.CurWord);
-
- // clip active left part of the current word
- ClipPlaneEq[0] := -ClipPlaneEq[0];
- ClipPlaneEq[3] := -ClipPlaneEq[3];
- glClipPlane(GL_CLIP_PLANE0, @ClipPlaneEq);
- // and draw non-active right part
- glColor4f(LineColor_en.r, LineColor_en.g, LineColor_en.b, Alpha);
- DrawLyricsWords(Line, 0, 0, Line.CurWord, Line.CurWord);
-
- glPopMatrix;
-
- glDisable(GL_CLIP_PLANE0);
- end;
-
- // draw the ball onto the current word
- if (LyricsEffect = lfxBall) then
- begin
- DrawBall(LyricX + CurWord.X + CurWord.Width * Progress,
- LyricY - 15 - 15*sin(Progress * Pi), Alpha);
- end;
- end
- else
- begin
- // this section is called if the whole line can be drawn at once and no
- // word is highlighted.
-
- // enable the upper, disable the lower line
- if (Line = UpperLine) then
- glColorRGB(LineColor_en)
- else
- glColorRGB(LineColor_dis);
-
- DrawLyricsWords(Line, LyricX, LyricY, 0, High(Line.Words));
- end;
-end;
-
-{**
- * @returns a reference to the upper line
- *}
-function TLyricEngine.GetUpperLine(): TLyricLine;
-begin
- Result := UpperLine;
-end;
-
-{**
- * @returns a reference to the lower line
- *}
-function TLyricEngine.GetLowerLine(): TLyricLine;
-begin
- Result := LowerLine;
-end;
-
-{**
- * @returns the index of the upper line
- *}
-function TLyricEngine.GetUpperLineIndex(): integer;
-const
- QUEUE_SIZE = 3;
-begin
- // no line in queue
- if (LineCounter <= 0) then
- Result := -1
- // no line has been removed from queue yet
- else if (LineCounter <= QUEUE_SIZE) then
- Result := 0
- // lines have been removed from queue already
- else
- Result := LineCounter - QUEUE_SIZE;
-end;
-
-end.
-
diff --git a/src/base/UMain.pas b/src/base/UMain.pas
deleted file mode 100644
index d5e0ccb3..00000000
--- a/src/base/UMain.pas
+++ /dev/null
@@ -1,569 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UMain;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- SysUtils,
- SDL;
-
-var
- Done: boolean;
- Restart: boolean;
-
-procedure Main;
-procedure MainLoop;
-procedure CheckEvents;
-
-type
- TMainThreadExecProc = procedure(Data: Pointer);
-
-const
- MAINTHREAD_EXEC_EVENT = SDL_USEREVENT + 2;
-
-{*
- * Delegates execution of procedure Proc to the main thread.
- * The Data pointer is passed to the procedure when it is called.
- * The main thread is notified by signaling a MAINTHREAD_EXEC_EVENT which
- * is handled in CheckEvents.
- * Note that Data must not be a pointer to local data. If you want to pass local
- * data, use Getmem() or New() or create a temporary object.
- *}
-procedure MainThreadExec(Proc: TMainThreadExecProc; Data: Pointer);
-
-implementation
-
-uses
- Math,
- gl,
- UCatCovers,
- UCommandLine,
- UCommon,
- UConfig,
- UCovers,
- UDataBase,
- UDisplay,
- UDLLManager,
- UGraphic,
- UGraphicClasses,
- UIni,
- UJoystick,
- ULanguage,
- ULog,
- UPathUtils,
- UPlaylist,
- UMusic,
- UBeatTimer,
- UPlatform,
- USkins,
- USongs,
- UThemes,
- UParty,
- UTime;
-
-procedure Main;
-var
- WindowTitle: string;
-begin
- {$IFNDEF Debug}
- try
- {$ENDIF}
- WindowTitle := USDXVersionStr;
-
- Platform.Init;
-
- if Platform.TerminateIfAlreadyRunning(WindowTitle) then
- Exit;
-
- // fix floating-point exceptions (FPE)
- DisableFloatingPointExceptions();
- // fix the locale for string-to-float parsing in C-libs
- SetDefaultNumericLocale();
-
- // setup separators for parsing
- // Note: ThousandSeparator must be set because of a bug in TIniFile.ReadFloat
- ThousandSeparator := ',';
- DecimalSeparator := '.';
-
- //------------------------------
- // StartUp - create classes and load files
- //------------------------------
-
- // initialize SDL
- // without SDL_INIT_TIMER SDL_GetTicks() might return strange values
- SDL_Init(SDL_INIT_VIDEO or SDL_INIT_TIMER);
- SDL_EnableUnicode(1);
-
- USTime := TTime.Create;
- VideoBGTimer := TRelativeTimer.Create;
-
- // Commandline Parameter Parser
- Params := TCMDParams.Create;
-
- // Log + Benchmark
- Log := TLog.Create;
- Log.Title := WindowTitle;
- Log.FileOutputEnabled := not Params.NoLog;
- Log.BenchmarkStart(0);
-
- // Language
- Log.BenchmarkStart(1);
- Log.LogStatus('Initialize Paths', 'Initialization');
- InitializePaths;
- Log.LogStatus('Load Language', 'Initialization');
- Language := TLanguage.Create;
-
- // add const values:
- Language.AddConst('US_VERSION', USDXVersionStr);
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Loading Language', 1);
-
-{
- // SDL_ttf (Not used yet, maybe in version 1.5)
- Log.BenchmarkStart(1);
- Log.LogStatus('Initialize SDL_ttf', 'Initialization');
- TTF_Init();
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Initializing SDL_ttf', 1);
-}
-
- // Skin
- Log.BenchmarkStart(1);
- Log.LogStatus('Loading Skin List', 'Initialization');
- Skin := TSkin.Create;
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Loading Skin List', 1);
-
- // Ini + Paths
- Log.BenchmarkStart(1);
- Log.LogStatus('Load Ini', 'Initialization');
- Ini := TIni.Create;
- Ini.Load;
-
- // it is possible that this is the first run, create a .ini file if neccessary
- Log.LogStatus('Write Ini', 'Initialization');
- Ini.Save;
-
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Loading Ini', 1);
-
- // Sound
- Log.BenchmarkStart(1);
- Log.LogStatus('Initialize Sound', 'Initialization');
- InitializeSound();
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Initializing Sound', 1);
-
- // Lyrics-engine with media reference timer
- LyricsState := TLyricsState.Create();
-
- // Theme
- Log.BenchmarkStart(1);
- Log.LogStatus('Load Themes', 'Initialization');
- Theme := TTheme.Create(ThemePath.Append(ITheme[Ini.Theme] + '.ini'), Ini.Color);
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Loading Themes', 1);
-
- // Covers Cache
- Log.BenchmarkStart(1);
- Log.LogStatus('Creating Covers Cache', 'Initialization');
- Covers := TCoverDatabase.Create;
- Log.LogBenchmark('Loading Covers Cache Array', 1);
- Log.BenchmarkStart(1);
-
- // Category Covers
- Log.BenchmarkStart(1);
- Log.LogStatus('Creating Category Covers Array', 'Initialization');
- CatCovers:= TCatCovers.Create;
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Loading Category Covers Array', 1);
-
- // Songs
- //Log.BenchmarkStart(1);
- Log.LogStatus('Creating Song Array', 'Initialization');
- Songs := TSongs.Create;
- //Songs.LoadSongList;
-
- Log.LogStatus('Creating 2nd Song Array', 'Initialization');
- CatSongs := TCatSongs.Create;
-
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Loading Songs', 1);
-
- // PluginManager
- Log.BenchmarkStart(1);
- Log.LogStatus('PluginManager', 'Initialization');
- DLLMan := TDLLMan.Create; // Load PluginList
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Loading PluginManager', 1);
-
- // Party Mode Manager
- Log.BenchmarkStart(1);
- Log.LogStatus('PartySession Manager', 'Initialization');
- PartySession := TPartySession.Create; //Load PartySession
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Loading PartySession Manager', 1);
-
- // Graphics
- Log.BenchmarkStart(1);
- Log.LogStatus('Initialize 3D', 'Initialization');
- Initialize3D(WindowTitle);
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Initializing 3D', 1);
-
- // Score Saving System
- Log.BenchmarkStart(1);
- Log.LogStatus('DataBase System', 'Initialization');
- DataBase := TDataBaseSystem.Create;
-
- if (Params.ScoreFile.IsUnset) then
- DataBase.Init(Platform.GetGameUserPath.Append('Ultrastar.db'))
- else
- DataBase.Init(Params.ScoreFile);
-
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Loading DataBase System', 1);
-
- // Playlist Manager
- Log.BenchmarkStart(1);
- Log.LogStatus('Playlist Manager', 'Initialization');
- PlaylistMan := TPlaylistManager.Create;
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Loading Playlist Manager', 1);
-
- // GoldenStarsTwinkleMod
- Log.BenchmarkStart(1);
- Log.LogStatus('Effect Manager', 'Initialization');
- GoldenRec := TEffectManager.Create;
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Loading Particle System', 1);
-
- // Joypad
- if (Ini.Joypad = 1) or (Params.Joypad) then
- begin
- Log.BenchmarkStart(1);
- Log.LogStatus('Initialize Joystick', 'Initialization');
- Joy := TJoy.Create;
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Initializing Joystick', 1);
- end;
-
- Log.BenchmarkEnd(0);
- Log.LogBenchmark('Loading Time', 0);
-
- Log.LogStatus('Creating Core', 'Initialization');
-{
- Core := TCore.Create(
- USDXShortVersionStr,
- MakeVersion(USDX_VERSION_MAJOR,
- USDX_VERSION_MINOR,
- USDX_VERSION_RELEASE,
- chr(0))
- );
-}
-
- Log.LogStatus('Running Core', 'Initialization');
- //Core.Run;
-
- //------------------------------
- // Start Mainloop
- //------------------------------
- Log.LogStatus('Main Loop', 'Initialization');
- MainLoop;
-
- {$IFNDEF Debug}
- finally
- {$ENDIF}
- //------------------------------
- // Finish Application
- //------------------------------
-
- // TODO:
- // call an uninitialize routine for every initialize step
- // or at least use the corresponding Free methods
-
- FinalizeMedia();
-
- //TTF_Quit();
- SDL_Quit();
-
- if assigned(Log) then
- begin
- Log.LogStatus('Main Loop', 'Finished');
- Log.Free;
- end;
- {$IFNDEF Debug}
- end;
- {$ENDIF}
-end;
-
-procedure MainLoop;
-var
- Delay: integer;
-const
- MAX_FPS = 100;
-begin
- SDL_EnableKeyRepeat(125, 125);
-
- CountSkipTime(); // JB - for some reason this seems to be needed when we use the SDL Timer functions.
- while not Done do
- begin
- // joypad
- if (Ini.Joypad = 1) or (Params.Joypad) then
- Joy.Update;
-
- // keyboard events
- CheckEvents;
-
- // display
- Done := not Display.Draw;
- SwapBuffers;
-
- // delay
- CountMidTime;
-
- Delay := Floor(1000 / MAX_FPS - 1000 * TimeMid);
-
- if Delay >= 1 then
- SDL_Delay(Delay); // dynamic, maximum is 100 fps
-
- CountSkipTime;
-
- // reinitialization of graphics
- if Restart then
- begin
- Reinitialize3D;
- Restart := false;
- end;
-
- end;
-end;
-
-procedure DoQuit;
-begin
- // if question option is enabled then show exit popup
- if (Ini.AskbeforeDel = 1) then
- begin
- Display.CurrentScreen^.CheckFadeTo(nil,'MSG_QUIT_USDX');
- end
- else // if ask-for-exit is disabled then simply exit
- begin
- Display.Fade := 0;
- Display.NextScreenWithCheck := nil;
- Display.CheckOK := true;
- end;
-end;
-
-procedure CheckEvents;
-var
- Event: TSDL_event;
- mouseDown: boolean;
- mouseBtn: integer;
-begin
- while (SDL_PollEvent(@Event) <> 0) do
- begin
- case Event.type_ of
- SDL_QUITEV:
- begin
- Display.Fade := 0;
- Display.NextScreenWithCheck := nil;
- Display.CheckOK := true;
- end;
-
- SDL_MOUSEMOTION, SDL_MOUSEBUTTONDOWN, SDL_MOUSEBUTTONUP:
- begin
- if (Ini.Mouse > 0) then
- begin
- case Event.type_ of
- SDL_MOUSEMOTION:
- begin
- mouseDown := false;
- mouseBtn := 0;
- end;
- SDL_MOUSEBUTTONDOWN:
- begin
- mouseDown := true;
- mouseBtn := Event.button.button;
-
- if (mouseBtn = SDL_BUTTON_LEFT) or (mouseBtn = SDL_BUTTON_RIGHT) then
- Display.OnMouseButton(true);
- end;
- SDL_MOUSEBUTTONUP:
- begin
- mouseDown := false;
- mouseBtn := Event.button.button;
-
- if (mouseBtn = SDL_BUTTON_LEFT) or (mouseBtn = SDL_BUTTON_RIGHT) then
- Display.OnMouseButton(false);
- end;
- end;
-
- Display.MoveCursor(Event.button.X * 800 / Screen.w,
- Event.button.Y * 600 / Screen.h);
-
- if not Assigned(Display.NextScreen) then
- begin //drop input when changing screens
- if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then
- done := not ScreenPopupError.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y)
- else if (ScreenPopupInfo <> nil) and (ScreenPopupInfo.Visible) then
- done := not ScreenPopupInfo.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y)
- else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then
- done := not ScreenPopupCheck.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y)
- else
- begin
- done := not Display.CurrentScreen^.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y);
-
- // if screen wants to exit
- if done then
- DoQuit;
- end;
- end;
- end;
- end;
- SDL_VIDEORESIZE:
- begin
- ScreenW := Event.resize.w;
- ScreenH := Event.resize.h;
- // Note: do NOT call SDL_SetVideoMode on Windows and MacOSX here.
- // This would create a new OpenGL render-context and all texture data
- // would be invalidated.
- // On Linux the mode MUST be reset, otherwise graphics will be corrupted.
- {$IF Defined(Linux) or Defined(FreeBSD)}
- if boolean( Ini.FullScreen ) then
- SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN)
- else
- SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE);
- {$IFEND}
- end;
- SDL_KEYDOWN:
- begin
- // translate CTRL-A (ASCII 1) - CTRL-Z (ASCII 26) to correct charcodes.
- // keysyms (SDLK_A, ...) could be used instead but they ignore the
- // current key mapping (if 'a' is pressed on a French keyboard the
- // .unicode field will be 'a' and .sym SDLK_Q).
- // IMPORTANT: if CTRL is pressed with a key different than 'A'-'Z' SDL
- // will set .unicode to 0. There is no possibility to obtain a
- // translated charcode. Use keysyms instead.
- //if (Event.key.keysym.unicode in [1 .. 26]) then
- // Event.key.keysym.unicode := Ord('A') + Event.key.keysym.unicode - 1;
-
- // remap the "keypad enter" key to the "standard enter" key
- if (Event.key.keysym.sym = SDLK_KP_ENTER) then
- Event.key.keysym.sym := SDLK_RETURN;
-
- if not Assigned(Display.NextScreen) then
- begin //drop input when changing screens
- { to-do : F11 was used for fullscreen toggle, too here
- but we also use the key in screenname and some other
- screens. It is droped although fullscreen toggle doesn't
- even work on windows.
- should we add (Event.key.keysym.sym = SDLK_F11) here
- anyway? }
- if ((Event.key.keysym.sym = SDLK_RETURN) and
- ((Event.key.keysym.modifier and KMOD_ALT) <> 0)) then // toggle full screen
- begin
- Ini.FullScreen := integer( not boolean( Ini.FullScreen ) );
-
- // FIXME: SDL_SetVideoMode creates a new OpenGL RC so we have to
- // reload all texture data (-> whitescreen bug).
- // Only Linux and FreeBSD are able to handle screen-switching this way.
- {$IF Defined(Linux) or Defined(FreeBSD)}
- if boolean( Ini.FullScreen ) then
- begin
- SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN);
- end
- else
- begin
- SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE);
- end;
-
- Display.SetCursor;
-
- glViewPort(0, 0, ScreenW, ScreenH);
- {$IFEND}
- end
- // if print is pressed -> make screenshot and save to screenshot path
- else if (Event.key.keysym.sym = SDLK_SYSREQ) or (Event.key.keysym.sym = SDLK_PRINT) then
- Display.SaveScreenShot
- // if there is a visible popup then let it handle input instead of underlying screen
- // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check)
- else if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then
- Done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true)
- else if (ScreenPopupInfo <> nil) and (ScreenPopupInfo.Visible) then
- Done := not ScreenPopupInfo.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true)
- else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then
- Done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true)
- else
- begin
- // check if screen wants to exit
- Done := not Display.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true);
-
- // if screen wants to exit
- if Done then
- DoQuit;
-
- end;
- end;
- end;
- SDL_JOYAXISMOTION:
- begin
- // not implemented
- end;
- SDL_JOYBUTTONDOWN:
- begin
- // not implemented
- end;
- MAINTHREAD_EXEC_EVENT:
- with Event.user do
- begin
- TMainThreadExecProc(data1)(data2);
- end;
- end; // case
- end; // while
-end;
-
-procedure MainThreadExec(Proc: TMainThreadExecProc; Data: Pointer);
-var
- Event: TSDL_Event;
-begin
- with Event.user do
- begin
- type_ := MAINTHREAD_EXEC_EVENT;
- code := 0; // not used at the moment
- data1 := @Proc;
- data2 := Data;
- end;
- SDL_PushEvent(@Event);
-end;
-
-end.
diff --git a/src/base/UMusic.pas b/src/base/UMusic.pas
deleted file mode 100644
index e1184da8..00000000
--- a/src/base/UMusic.pas
+++ /dev/null
@@ -1,1139 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UMusic;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- SysUtils,
- Classes,
- UTime,
- UBeatTimer,
- UPath;
-
-type
- TNoteType = (ntFreestyle, ntNormal, ntGolden);
-
-const
- // ScoreFactor defines how a notehit of a specified notetype is
- // measured in comparison to the other types
- // 0 means this notetype is not rated at all
- // 2 means a hit of this notetype will be rated w/ twice as much
- // points as a hit of a notetype w/ ScoreFactor 1
- ScoreFactor: array[TNoteType] of integer = (0, 1, 2);
-
-type
- (**
- * TLineFragment represents a fragment of a lyrics line.
- * This is a text-fragment (e.g. a syllable) assigned to a note pitch,
- * represented by a bar in the sing-screen.
- *)
- PLineFragment = ^TLineFragment;
- TLineFragment = record
- Color: integer;
- Start: integer; // beat the fragment starts at
- Length: integer; // length in beats
- Tone: integer; // full range tone
- Text: UTF8String; // text assigned to this fragment (a syllable, word, etc.)
- NoteType: TNoteType; // note-type: golden-note/freestyle etc.
- end;
-
- (**
- * TLine represents one lyrics line and consists of multiple
- * notes.
- *)
- PLine = ^TLine;
- TLine = record
- Start: integer; // the start beat of this line (<> start beat of the first note of this line)
- Lyric: UTF8String;
- //LyricWidth: real; // @deprecated: width of the line in pixels.
- // Do not use this as the width is not correct.
- // Use TLyricsEngine.GetUpperLine().Width instead.
- End_: integer;
- BaseNote: integer;
- HighNote: integer; // index of last note in line (= High(Note)?)
- TotalNotes: integer; // value of all notes in the line
- LastLine: boolean;
- Note: array of TLineFragment;
- end;
-
- (**
- * TLines stores sets of lyric lines and information on them.
- * Normally just one set is defined but in duet mode it might for example
- * contain two sets.
- *)
- TLines = record
- Current: integer; // for drawing of current line
- High: integer; // = High(Line)!
- Number: integer;
- Resolution: integer;
- NotesGAP: integer;
- ScoreValue: integer;
- Line: array of TLine;
- end;
-
-const
- FFTSize = 512; // size of FFT data (output: FFTSize/2 values)
-type
- TFFTData = array[0..(FFTSize div 2)-1] of Single;
-
-type
- PPCMStereoSample = ^TPCMStereoSample;
- TPCMStereoSample = array[0..1] of SmallInt;
- TPCMData = array[0..511] of TPCMStereoSample;
-
-type
- TStreamStatus = (ssStopped, ssPlaying, ssPaused);
-const
- StreamStatusStr: array[TStreamStatus] of string =
- ('Stopped', 'Playing', 'Paused');
-
-type
- TAudioSampleFormat = (
- asfU8, asfS8, // unsigned/signed 8 bits
- asfU16LSB, asfS16LSB, // unsigned/signed 16 bits (endianness: LSB)
- asfU16MSB, asfS16MSB, // unsigned/signed 16 bits (endianness: MSB)
- asfU16, asfS16, // unsigned/signed 16 bits (endianness: System)
- asfS32, // signed 32 bits (endianness: System)
- asfFloat, // float
- asfDouble // double
- );
-
-const
- // Size of one sample (one channel only) in bytes
- AudioSampleSize: array[TAudioSampleFormat] of integer = (
- 1, 1, // asfU8, asfS8
- 2, 2, // asfU16LSB, asfS16LSB
- 2, 2, // asfU16MSB, asfS16MSB
- 2, 2, // asfU16, asfS16
- 3, // asfS24
- 4, // asfS32
- 4 // asfFloat
- );
-
-const
- CHANNELMAP_LEFT = 1;
- CHANNELMAP_RIGHT = 2;
- CHANNELMAP_FRONT = CHANNELMAP_LEFT or CHANNELMAP_RIGHT;
-
-type
- TAudioFormatInfo = class
- private
- fSampleRate : double;
- fChannels : byte;
- fFormat : TAudioSampleFormat;
- fFrameSize : integer;
-
- procedure SetChannels(Channels: byte);
- procedure SetFormat(Format: TAudioSampleFormat);
- procedure UpdateFrameSize();
- function GetBytesPerSec(): double;
- public
- constructor Create(Channels: byte; SampleRate: double; Format: TAudioSampleFormat);
- function Copy(): TAudioFormatInfo;
-
- (**
- * Returns the inverse ratio of the size of data in this format to its
- * size in a given target format.
- * Example: SrcSize*SrcInfo.GetRatio(TgtInfo) = TgtSize
- *)
- function GetRatio(TargetInfo: TAudioFormatInfo): double;
-
- property SampleRate: double read fSampleRate write fSampleRate;
- property Channels: byte read fChannels write SetChannels;
- property Format: TAudioSampleFormat read fFormat write SetFormat;
- property FrameSize: integer read fFrameSize;
- property BytesPerSec: double read GetBytesPerSec;
- end;
-
-type
- TSoundEffect = class
- public
- EngineData: Pointer; // can be used for engine-specific data
- procedure Callback(Buffer: PByteArray; BufSize: integer); virtual; abstract;
- end;
-
- TVoiceRemoval = class(TSoundEffect)
- public
- procedure Callback(Buffer: PByteArray; BufSize: integer); override;
- end;
-
-type
- ISyncSource = interface
- function GetClock(): real;
- end;
-
- TAudioProcessingStream = class;
- TOnCloseHandler = procedure(Stream: TAudioProcessingStream);
-
- TAudioProcessingStream = class
- protected
- OnCloseHandlers: array of TOnCloseHandler;
-
- function GetLength(): real; virtual; abstract;
- function GetPosition(): real; virtual; abstract;
- procedure SetPosition(Time: real); virtual; abstract;
- function GetLoop(): boolean; virtual; abstract;
- procedure SetLoop(Enabled: boolean); virtual; abstract;
-
- procedure PerformOnClose();
- public
- function GetAudioFormatInfo(): TAudioFormatInfo; virtual; abstract;
- procedure Close(); virtual; abstract;
-
- (**
- * Adds a new OnClose action handler.
- * The handlers are performed in the order they were added.
- * If not stated explicitely, member-variables might have been invalidated
- * already. So do not use any member (variable/method/...) if you are not
- * sure it is valid.
- *)
- procedure AddOnCloseHandler(Handler: TOnCloseHandler);
-
- property Length: real read GetLength;
- property Position: real read GetPosition write SetPosition;
- property Loop: boolean read GetLoop write SetLoop;
- end;
-
- TAudioSourceStream = class(TAudioProcessingStream)
- protected
- function IsEOF(): boolean; virtual; abstract;
- function IsError(): boolean; virtual; abstract;
- public
- function ReadData(Buffer: PByteArray; BufferSize: integer): integer; virtual; abstract;
-
- property EOF: boolean read IsEOF;
- property Error: boolean read IsError;
- end;
-
- (*
- * State-Chart for playback-stream state transitions
- * []: Transition, (): State
- *
- * /---[Play/FadeIn]--->-\ /-------[Pause]----->-\
- * -[Create]->(Stop) (Play) (Pause)
- * \\-<-[Stop/EOF*/Error]-/ \-<---[Play/FadeIn]--//
- * \-<------------[Stop/EOF*/Error]--------------/
- *
- * *: if not looped, otherwise stream is repeated
- * Note: SetPosition() does not change the state.
- *)
-
- TAudioPlaybackStream = class(TAudioProcessingStream)
- protected
- SyncSource: ISyncSource;
- AvgSyncDiff: double;
- SourceStream: TAudioSourceStream;
-
- function GetLatency(): double; virtual; abstract;
- function GetStatus(): TStreamStatus; virtual; abstract;
- function GetVolume(): single; virtual; abstract;
- procedure SetVolume(Volume: single); virtual; abstract;
- function Synchronize(BufferSize: integer; FormatInfo: TAudioFormatInfo): integer;
- procedure FillBufferWithFrame(Buffer: PByteArray; BufferSize: integer; Frame: PByteArray; FrameSize: integer);
- public
- (**
- * Opens a SourceStream for playback.
- * Note that the caller (not the TAudioPlaybackStream) is responsible to
- * free the SourceStream after the Playback-Stream is closed.
- * You may use an OnClose-handler to achieve this. GetSourceStream()
- * guarantees to deliver this method's SourceStream parameter to
- * the OnClose-handler. Freeing SourceStream at OnClose is allowed.
- *)
- function Open(SourceStream: TAudioSourceStream): boolean; virtual; abstract;
-
- procedure Play(); virtual; abstract;
- procedure Pause(); virtual; abstract;
- procedure Stop(); virtual; abstract;
- procedure FadeIn(Time: real; TargetVolume: single); virtual; abstract;
-
- procedure GetFFTData(var data: TFFTData); virtual; abstract;
- function GetPCMData(var data: TPCMData): Cardinal; virtual; abstract;
-
- procedure AddSoundEffect(Effect: TSoundEffect); virtual; abstract;
- procedure RemoveSoundEffect(Effect: TSoundEffect); virtual; abstract;
-
- procedure SetSyncSource(SyncSource: ISyncSource);
- function GetSourceStream(): TAudioSourceStream;
-
- property Status: TStreamStatus read GetStatus;
- property Volume: single read GetVolume write SetVolume;
- end;
-
- TAudioDecodeStream = class(TAudioSourceStream)
- end;
-
- TAudioVoiceStream = class(TAudioSourceStream)
- protected
- FormatInfo: TAudioFormatInfo;
- ChannelMap: integer;
- public
- destructor Destroy; override;
-
- function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; virtual;
- procedure Close(); override;
-
- procedure WriteData(Buffer: PByteArray; BufferSize: integer); virtual; abstract;
- function GetAudioFormatInfo(): TAudioFormatInfo; override;
-
- function GetLength(): real; override;
- function GetPosition(): real; override;
- procedure SetPosition(Time: real); override;
- function GetLoop(): boolean; override;
- procedure SetLoop(Enabled: boolean); override;
- end;
-
-type
- // soundcard output-devices information
- TAudioOutputDevice = class
- public
- Name: UTF8String; // soundcard name
- end;
- TAudioOutputDeviceList = array of TAudioOutputDevice;
-
-type
- IGenericPlayback = Interface
- ['{63A5EBC3-3F4D-4F23-8DFB-B5165FCE33DD}']
- function GetName: String;
-
- function Open(const Filename: IPath): boolean; // true if succeed
- procedure Close;
-
- procedure Play;
- procedure Pause;
- procedure Stop;
-
- procedure SetPosition(Time: real);
- function GetPosition: real;
-
- property Position: real read GetPosition write SetPosition;
- end;
-
- IVideoPlayback = Interface( IGenericPlayback )
- ['{3574C40C-28AE-4201-B3D1-3D1F0759B131}']
- function Init(): boolean;
- function Finalize: boolean;
-
- procedure GetFrame(Time: Extended); // WANT TO RENAME THESE TO BE MORE GENERIC
- procedure DrawGL(Screen: integer); // WANT TO RENAME THESE TO BE MORE GENERIC
-
- end;
-
- IVideoVisualization = Interface( IVideoPlayback )
- ['{5AC17D60-B34D-478D-B632-EB00D4078017}']
- end;
-
- IAudioPlayback = Interface( IGenericPlayback )
- ['{E4AE0B40-3C21-4DC5-847C-20A87E0DFB96}']
- function InitializePlayback: boolean;
- function FinalizePlayback: boolean;
-
- function GetOutputDeviceList(): TAudioOutputDeviceList;
-
- procedure SetAppVolume(Volume: single);
- procedure SetVolume(Volume: single);
- procedure SetLoop(Enabled: boolean);
-
- procedure FadeIn(Time: real; TargetVolume: single);
- procedure SetSyncSource(SyncSource: ISyncSource);
-
- procedure Rewind;
- function Finished: boolean;
- function Length: real;
-
- // Sounds
- // TODO:
- // add a TMediaDummyPlaybackStream implementation that will
- // be used by the TSoundLib whenever OpenSound() fails, so checking for
- // nil-pointers is not neccessary anymore.
- // PlaySound/StopSound will be removed then, OpenSound will be renamed to
- // CreateSound.
- function OpenSound(const Filename: IPath): TAudioPlaybackStream;
- procedure PlaySound(Stream: TAudioPlaybackStream);
- procedure StopSound(Stream: TAudioPlaybackStream);
-
- // Equalizer
- procedure GetFFTData(var Data: TFFTData);
-
- // Interface for Visualizer
- function GetPCMData(var Data: TPCMData): Cardinal;
-
- function CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream;
- end;
-
- IGenericDecoder = Interface
- ['{557B0E9A-604D-47E4-B826-13769F3E10B7}']
- function GetName(): string;
- function InitializeDecoder(): boolean;
- function FinalizeDecoder(): boolean;
- //function IsSupported(const Filename: string): boolean;
- end;
-
- (*
- IVideoDecoder = Interface( IGenericDecoder )
- ['{2F184B2B-FE69-44D5-9031-0A2462391DCA}']
- function Open(const Filename: IPath): TVideoDecodeStream;
- end;
- *)
-
- IAudioDecoder = Interface( IGenericDecoder )
- ['{AB47B1B6-2AA9-4410-BF8C-EC79561B5478}']
- function Open(const Filename: IPath): TAudioDecodeStream;
- end;
-
- IAudioInput = Interface
- ['{A5C8DA92-2A0C-4AB2-849B-2F7448C6003A}']
- function GetName: String;
- function InitializeRecord: boolean;
- function FinalizeRecord(): boolean;
-
- procedure CaptureStart;
- procedure CaptureStop;
- end;
-
-type
- TAudioConverter = class
- protected
- fSrcFormatInfo: TAudioFormatInfo;
- fDstFormatInfo: TAudioFormatInfo;
- public
- function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; virtual;
- destructor Destroy(); override;
-
- (**
- * Converts the InputBuffer and stores the result in OutputBuffer.
- * If the result is not -1, InputSize will be set to the actual number of
- * input-buffer bytes used.
- * Returns the number of bytes written to the output-buffer or -1 if an error occured.
- *)
- function Convert(InputBuffer: PByteArray; OutputBuffer: PByteArray; var InputSize: integer): integer; virtual; abstract;
-
- (**
- * Destination/Source size ratio
- *)
- function GetRatio(): double; virtual; abstract;
-
- function GetOutputBufferSize(InputSize: integer): integer; virtual; abstract;
- property SrcFormatInfo: TAudioFormatInfo read fSrcFormatInfo;
- property DstFormatInfo: TAudioFormatInfo read fDstFormatInfo;
- end;
-
-(* TODO
-const
- SOUNDID_START = 0;
- SOUNDID_BACK = 1;
- SOUNDID_SWOOSH = 2;
- SOUNDID_CHANGE = 3;
- SOUNDID_OPTION = 4;
- SOUNDID_CLICK = 5;
- LAST_SOUNDID = SOUNDID_CLICK;
-
- BaseSoundFilenames: array[0..LAST_SOUNDID] of IPath = (
- '%SOUNDPATH%/Common start.mp3', // Start
- '%SOUNDPATH%/Common back.mp3', // Back
- '%SOUNDPATH%/menu swoosh.mp3', // Swoosh
- '%SOUNDPATH%/select music change music 50.mp3', // Change
- '%SOUNDPATH%/option change col.mp3', // Option
- '%SOUNDPATH%/rimshot022b.mp3' // Click
- {
- '%SOUNDPATH%/bassdrumhard076b.mp3', // Drum (unused)
- '%SOUNDPATH%/hihatclosed068b.mp3', // Hihat (unused)
- '%SOUNDPATH%/claps050b.mp3', // Clap (unused)
- '%SOUNDPATH%/Shuffle.mp3' // Shuffle (unused)
- }
- );
-*)
-
-type
- TSoundLibrary = class
- private
- // TODO
- //Sounds: array of TAudioPlaybackStream;
- public
- // TODO: move sounds to the private section
- // and provide IDs instead.
- Start: TAudioPlaybackStream;
- Back: TAudioPlaybackStream;
- Swoosh: TAudioPlaybackStream;
- Change: TAudioPlaybackStream;
- Option: TAudioPlaybackStream;
- Click: TAudioPlaybackStream;
- BGMusic: TAudioPlaybackStream;
-
- constructor Create();
- destructor Destroy(); override;
-
- procedure LoadSounds();
- procedure UnloadSounds();
-
- procedure StartBgMusic();
- procedure PauseBgMusic();
- // TODO
- //function AddSound(Filename: IPath): integer;
- //procedure RemoveSound(ID: integer);
- //function GetSound(ID: integer): TAudioPlaybackStream;
- //property Sound[ID: integer]: TAudioPlaybackStream read GetSound; default;
- end;
-
-var
- // TODO: JB --- THESE SHOULD NOT BE GLOBAL
- Lines: array of TLines;
- LyricsState: TLyricsState;
- SoundLib: TSoundLibrary;
-
-
-procedure InitializeSound;
-procedure InitializeVideo;
-procedure FinalizeMedia;
-
-function Visualization(): IVideoPlayback;
-function VideoPlayback(): IVideoPlayback;
-function AudioPlayback(): IAudioPlayback;
-function AudioInput(): IAudioInput;
-function AudioDecoders(): TInterfaceList;
-
-function MediaManager: TInterfaceList;
-
-procedure DumpMediaInterfaces();
-
-implementation
-
-uses
- math,
- UIni,
- UNote,
- UCommandLine,
- URecord,
- ULog,
- UPathUtils;
-
-var
- DefaultVideoPlayback : IVideoPlayback;
- DefaultVisualization : IVideoPlayback;
- DefaultAudioPlayback : IAudioPlayback;
- DefaultAudioInput : IAudioInput;
- AudioDecoderList : TInterfaceList;
- MediaInterfaceList : TInterfaceList;
-
-
-constructor TAudioFormatInfo.Create(Channels: byte; SampleRate: double; Format: TAudioSampleFormat);
-begin
- inherited Create();
- fChannels := Channels;
- fSampleRate := SampleRate;
- fFormat := Format;
- UpdateFrameSize();
-end;
-
-procedure TAudioFormatInfo.SetChannels(Channels: byte);
-begin
- fChannels := Channels;
- UpdateFrameSize();
-end;
-
-procedure TAudioFormatInfo.SetFormat(Format: TAudioSampleFormat);
-begin
- fFormat := Format;
- UpdateFrameSize();
-end;
-
-function TAudioFormatInfo.GetBytesPerSec(): double;
-begin
- Result := FrameSize * SampleRate;
-end;
-
-procedure TAudioFormatInfo.UpdateFrameSize();
-begin
- fFrameSize := AudioSampleSize[fFormat] * fChannels;
-end;
-
-function TAudioFormatInfo.Copy(): TAudioFormatInfo;
-begin
- Result := TAudioFormatInfo.Create(Self.Channels, Self.SampleRate, Self.Format);
-end;
-
-function TAudioFormatInfo.GetRatio(TargetInfo: TAudioFormatInfo): double;
-begin
- Result := (TargetInfo.FrameSize / Self.FrameSize) *
- (TargetInfo.SampleRate / Self.SampleRate)
-end;
-
-
-function MediaManager: TInterfaceList;
-begin
- if (not assigned(MediaInterfaceList)) then
- MediaInterfaceList := TInterfaceList.Create();
- Result := MediaInterfaceList;
-end;
-
-function VideoPlayback(): IVideoPlayback;
-begin
- Result := DefaultVideoPlayback;
-end;
-
-function Visualization(): IVideoPlayback;
-begin
- Result := DefaultVisualization;
-end;
-
-function AudioPlayback(): IAudioPlayback;
-begin
- Result := DefaultAudioPlayback;
-end;
-
-function AudioInput(): IAudioInput;
-begin
- Result := DefaultAudioInput;
-end;
-
-function AudioDecoders(): TInterfaceList;
-begin
- Result := AudioDecoderList;
-end;
-
-procedure FilterInterfaceList(const IID: TGUID; InList, OutList: TInterfaceList);
-var
- i: integer;
- obj: IInterface;
-begin
- if (not assigned(OutList)) then
- Exit;
-
- OutList.Clear;
- for i := 0 to InList.Count-1 do
- begin
- if assigned(InList[i]) then
- begin
- // add object to list if it implements the interface searched for
- if (InList[i].QueryInterface(IID, obj) = 0) then
- OutList.Add(obj);
- end;
- end;
-end;
-
-procedure InitializeSound;
-var
- i: integer;
- InterfaceList: TInterfaceList;
- CurrentAudioDecoder: IAudioDecoder;
- CurrentAudioPlayback: IAudioPlayback;
- CurrentAudioInput: IAudioInput;
-begin
- // create a temporary list for interface enumeration
- InterfaceList := TInterfaceList.Create();
-
- // initialize all audio-decoders first
- FilterInterfaceList(IAudioDecoder, MediaManager, InterfaceList);
- for i := 0 to InterfaceList.Count-1 do
- begin
- CurrentAudioDecoder := InterfaceList[i] as IAudioDecoder;
- if (not CurrentAudioDecoder.InitializeDecoder()) then
- begin
- Log.LogError('Initialize failed, Removing - '+ CurrentAudioDecoder.GetName);
- MediaManager.Remove(CurrentAudioDecoder);
- end;
- end;
-
- // create and setup decoder-list (see AudioDecoders())
- AudioDecoderList := TInterfaceList.Create;
- FilterInterfaceList(IAudioDecoder, MediaManager, AudioDecoders);
-
- // find and initialize playback interface
- DefaultAudioPlayback := nil;
- FilterInterfaceList(IAudioPlayback, MediaManager, InterfaceList);
- for i := 0 to InterfaceList.Count-1 do
- begin
- CurrentAudioPlayback := InterfaceList[i] as IAudioPlayback;
- if (CurrentAudioPlayback.InitializePlayback()) then
- begin
- DefaultAudioPlayback := CurrentAudioPlayback;
- break;
- end;
- Log.LogError('Initialize failed, Removing - '+ CurrentAudioPlayback.GetName);
- MediaManager.Remove(CurrentAudioPlayback);
- end;
-
- // find and initialize input interface
- DefaultAudioInput := nil;
- FilterInterfaceList(IAudioInput, MediaManager, InterfaceList);
- for i := 0 to InterfaceList.Count-1 do
- begin
- CurrentAudioInput := InterfaceList[i] as IAudioInput;
- if (CurrentAudioInput.InitializeRecord()) then
- begin
- DefaultAudioInput := CurrentAudioInput;
- break;
- end;
- Log.LogError('Initialize failed, Removing - '+ CurrentAudioInput.GetName);
- MediaManager.Remove(CurrentAudioInput);
- end;
-
- InterfaceList.Free;
-
- // Update input-device list with registered devices
- AudioInputProcessor.UpdateInputDeviceConfig();
-
- // Load in-game sounds
- SoundLib := TSoundLibrary.Create;
-end;
-
-procedure InitializeVideo();
-var
- i: integer;
- InterfaceList: TInterfaceList;
- VideoInterface: IVideoPlayback;
- VisualInterface: IVideoVisualization;
-begin
- InterfaceList := TInterfaceList.Create;
-
- // initialize and set video-playback singleton
- DefaultVideoPlayback := nil;
- FilterInterfaceList(IVideoPlayback, MediaManager, InterfaceList);
- for i := 0 to InterfaceList.Count-1 do
- begin
- VideoInterface := InterfaceList[i] as IVideoPlayback;
- if (VideoInterface.Init()) then
- begin
- DefaultVideoPlayback := VideoInterface;
- break;
- end;
- Log.LogError('Initialize failed, Removing - '+ VideoInterface.GetName);
- MediaManager.Remove(VideoInterface);
- end;
-
- // initialize and set visualization singleton
- DefaultVisualization := nil;
- FilterInterfaceList(IVideoVisualization, MediaManager, InterfaceList);
- for i := 0 to InterfaceList.Count-1 do
- begin
- VisualInterface := InterfaceList[i] as IVideoVisualization;
- if (VisualInterface.Init()) then
- begin
- DefaultVisualization := VisualInterface;
- break;
- end;
- Log.LogError('Initialize failed, Removing - '+ VisualInterface.GetName);
- MediaManager.Remove(VisualInterface);
- end;
-
- InterfaceList.Free;
-
- // now that we have all interfaces, we can dump them
- // TODO: move this to another place
- if FindCmdLineSwitch(cMediaInterfaces) then
- begin
- DumpMediaInterfaces();
- halt;
- end;
-end;
-
-procedure UnloadMediaModules;
-var
- i: integer;
- InterfaceList: TInterfaceList;
-begin
- FreeAndNil(AudioDecoderList);
- DefaultAudioPlayback := nil;
- DefaultAudioInput := nil;
- DefaultVideoPlayback := nil;
- DefaultVisualization := nil;
-
- // create temporary interface list
- InterfaceList := TInterfaceList.Create();
-
- // finalize audio playback interfaces (should be done before the decoders)
- FilterInterfaceList(IAudioPlayback, MediaManager, InterfaceList);
- for i := 0 to InterfaceList.Count-1 do
- (InterfaceList[i] as IAudioPlayback).FinalizePlayback();
-
- // finalize audio input interfaces
- FilterInterfaceList(IAudioInput, MediaManager, InterfaceList);
- for i := 0 to InterfaceList.Count-1 do
- (InterfaceList[i] as IAudioInput).FinalizeRecord();
-
- // finalize audio decoder interfaces
- FilterInterfaceList(IAudioDecoder, MediaManager, InterfaceList);
- for i := 0 to InterfaceList.Count-1 do
- (InterfaceList[i] as IAudioDecoder).FinalizeDecoder();
-
- // finalize video interfaces
- FilterInterfaceList(IVideoPlayback, MediaManager, InterfaceList);
- for i := 0 to InterfaceList.Count-1 do
- (InterfaceList[i] as IVideoPlayback).Finalize();
-
- // finalize audio decoder interfaces
- FilterInterfaceList(IVideoVisualization, MediaManager, InterfaceList);
- for i := 0 to InterfaceList.Count-1 do
- (InterfaceList[i] as IVideoVisualization).Finalize();
-
- InterfaceList.Free;
-
- // finally free interfaces (by removing all references to them)
- FreeAndNil(MediaInterfaceList);
-end;
-
-procedure FinalizeMedia;
-begin
- // stop, close and free sounds
- SoundLib.Free;
-
- // stop and close music stream
- if (AudioPlayback <> nil) then
- AudioPlayback.Close;
-
- // stop any active captures
- if (AudioInput <> nil) then
- AudioInput.CaptureStop;
-
- if (VideoPlayback <> nil) then
- VideoPlayback.Close;
-
- if (Visualization <> nil) then
- Visualization.Close;
-
- UnloadMediaModules();
-end;
-
-procedure DumpMediaInterfaces();
-begin
- writeln( '' );
- writeln( '--------------------------------------------------------------' );
- writeln( ' In-use Media Interfaces ' );
- writeln( '--------------------------------------------------------------' );
- writeln( 'Registered Audio Playback Interface : ' + AudioPlayback.GetName );
- writeln( 'Registered Audio Input Interface : ' + AudioInput.GetName );
- writeln( 'Registered Video Playback Interface : ' + VideoPlayback.GetName );
- writeln( 'Registered Visualization Interface : ' + Visualization.GetName );
- writeln( '--------------------------------------------------------------' );
- writeln( '' );
-end;
-
-
-{ TSoundLibrary }
-
-constructor TSoundLibrary.Create();
-begin
- inherited;
- LoadSounds();
-end;
-
-destructor TSoundLibrary.Destroy();
-begin
- UnloadSounds();
- inherited;
-end;
-
-procedure TSoundLibrary.LoadSounds();
-begin
- UnloadSounds();
-
- Start := AudioPlayback.OpenSound(SoundPath.Append('Common start.mp3'));
- Back := AudioPlayback.OpenSound(SoundPath.Append('Common back.mp3'));
- Swoosh := AudioPlayback.OpenSound(SoundPath.Append('menu swoosh.mp3'));
- Change := AudioPlayback.OpenSound(SoundPath.Append('select music change music 50.mp3'));
- Option := AudioPlayback.OpenSound(SoundPath.Append('option change col.mp3'));
- Click := AudioPlayback.OpenSound(SoundPath.Append('rimshot022b.mp3'));
-
- BGMusic := AudioPlayback.OpenSound(SoundPath.Append('Bebeto_-_Loop010.mp3'));
-
- if (BGMusic <> nil) then
- BGMusic.Loop := True;
-end;
-
-procedure TSoundLibrary.UnloadSounds();
-begin
- FreeAndNil(Start);
- FreeAndNil(Back);
- FreeAndNil(Swoosh);
- FreeAndNil(Change);
- FreeAndNil(Option);
- FreeAndNil(Click);
- FreeAndNil(BGMusic);
-end;
-
-(* TODO
-function TSoundLibrary.GetSound(ID: integer): TAudioPlaybackStream;
-begin
- if ((ID >= 0) and (ID < Length(Sounds))) then
- Result := Sounds[ID]
- else
- Result := nil;
-end;
-*)
-
-procedure TSoundLibrary.StartBgMusic();
-begin
- if (TBackgroundMusicOption(Ini.BackgroundMusicOption) = bmoOn) and
- (Soundlib.BGMusic <> nil) and not (Soundlib.BGMusic.Status = ssPlaying) then
- begin
- AudioPlayback.PlaySound(Soundlib.BGMusic);
- end;
-end;
-
-procedure TSoundLibrary.PauseBgMusic();
-begin
- If (Soundlib.BGMusic <> nil) then
- begin
- Soundlib.BGMusic.Pause;
- end;
-end;
-
-{ TVoiceRemoval }
-
-procedure TVoiceRemoval.Callback(Buffer: PByteArray; BufSize: integer);
-var
- FrameIndex, FrameSize: integer;
- Value: integer;
- Sample: PPCMStereoSample;
-begin
- FrameSize := 2 * SizeOf(SmallInt);
- for FrameIndex := 0 to (BufSize div FrameSize)-1 do
- begin
- Sample := PPCMStereoSample(Buffer);
- // channel difference
- Value := Sample[0] - Sample[1];
- // clip
- if (Value > High(SmallInt)) then
- Value := High(SmallInt)
- else if (Value < Low(SmallInt)) then
- Value := Low(SmallInt);
- // assign result
- Sample[0] := Value;
- Sample[1] := Value;
- // increase to next frame
- Inc(Buffer, FrameSize);
- end;
-end;
-
-{ TAudioConverter }
-
-function TAudioConverter.Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean;
-begin
- fSrcFormatInfo := SrcFormatInfo.Copy();
- fDstFormatInfo := DstFormatInfo.Copy();
- Result := true;
-end;
-
-destructor TAudioConverter.Destroy();
-begin
- FreeAndNil(fSrcFormatInfo);
- FreeAndNil(fDstFormatInfo);
-end;
-
-
-{ TAudioProcessingStream }
-
-procedure TAudioProcessingStream.AddOnCloseHandler(Handler: TOnCloseHandler);
-begin
- if (@Handler <> nil) then
- begin
- SetLength(OnCloseHandlers, System.Length(OnCloseHandlers)+1);
- OnCloseHandlers[High(OnCloseHandlers)] := @Handler;
- end;
-end;
-
-procedure TAudioProcessingStream.PerformOnClose();
-var i: integer;
-begin
- for i := 0 to High(OnCloseHandlers) do
- begin
- OnCloseHandlers[i](Self);
- end;
-end;
-
-
-{ TAudioPlaybackStream }
-
-function TAudioPlaybackStream.GetSourceStream(): TAudioSourceStream;
-begin
- Result := SourceStream;
-end;
-
-procedure TAudioPlaybackStream.SetSyncSource(SyncSource: ISyncSource);
-begin
- Self.SyncSource := SyncSource;
- AvgSyncDiff := -1;
-end;
-
-(*
- * Results an adjusted size of the input buffer size to keep the stream in sync
- * with the SyncSource. If no SyncSource was assigned to this stream, the
- * input buffer size will be returned, so this method will have no effect.
- *
- * These are the possible cases:
- * - Result > BufferSize: stream is behind the sync-source (stream is too slow),
- * (Result-BufferSize) bytes of the buffer must be skipped.
- * - Result = BufferSize: stream is in sync,
- * there is nothing to do.
- * - Result < BufferSize: stream is ahead of the sync-source (stream is too fast),
- * (BufferSize-Result) bytes of the buffer must be padded.
- *)
-function TAudioPlaybackStream.Synchronize(BufferSize: integer; FormatInfo: TAudioFormatInfo): integer;
-var
- TimeDiff: double;
- TimeCorrectionFactor: double;
-const
- AVG_HISTORY_FACTOR = 0.9;
- SYNC_THRESHOLD = 0.045;
- MAX_SYNC_DIFF_TIME = 0.002;
-begin
- Result := BufferSize;
-
- if (not assigned(SyncSource)) then
- Exit;
-
- if (BufferSize <= 0) then
- Exit;
-
- // difference between sync-source and stream position
- // (negative if the music-stream's position is ahead of the master clock)
- TimeDiff := SyncSource.GetClock() - (Position - GetLatency());
-
- // calculate average time difference (some sort of weighted mean).
- // The bigger AVG_HISTORY_FACTOR is, the smoother is the average diff.
- // This means that older diffs are weighted more with a higher history factor
- // than with a lower. Do not use a too low history factor. FFmpeg produces
- // very instable timestamps (pts) for ogg due to some bugs. They may differ
- // +-50ms from the real stream position. Without filtering those glitches we
- // would synch without any need, resulting in ugly plopping sounds.
- if (AvgSyncDiff = -1) then
- AvgSyncDiff := TimeDiff
- else
- AvgSyncDiff := TimeDiff * (1-AVG_HISTORY_FACTOR) +
- AvgSyncDiff * AVG_HISTORY_FACTOR;
-
- // check if sync needed
- if (Abs(AvgSyncDiff) >= SYNC_THRESHOLD) then
- begin
- // TODO: use SetPosition if diff is too large (>5s)
- if (TimeDiff < 1) then
- TimeCorrectionFactor := Sign(TimeDiff)*TimeDiff*TimeDiff
- else
- TimeCorrectionFactor := TimeDiff;
-
- // calculate adapted buffer size
- // reduce size of data to fetch if music is ahead, increase otherwise
- Result := BufferSize + Round(TimeCorrectionFactor * FormatInfo.SampleRate) * FormatInfo.FrameSize;
- if (Result < 0) then
- Result := 0;
-
- // reset average
- AvgSyncDiff := -1;
- end;
-
- (*
- DebugWriteln('Diff: ' + floattostrf(TimeDiff, ffFixed, 15, 3) +
- '| SyS: ' + floattostrf(SyncSource.GetClock(), ffFixed, 15, 3) +
- '| Pos: ' + floattostrf(Position, ffFixed, 15, 3) +
- '| Avg: ' + floattostrf(AvgSyncDiff, ffFixed, 15, 3));
- *)
-end;
-
-(*
- * Fills a buffer with copies of the given frame or with 0 if frame.
- *)
-procedure TAudioPlaybackStream.FillBufferWithFrame(Buffer: PByteArray; BufferSize: integer; Frame: PByteArray; FrameSize: integer);
-var
- i: integer;
- FrameCopyCount: integer;
-begin
- // the buffer must at least contain place for one copy of the frame.
- if ((Buffer = nil) or (BufferSize <= 0) or (BufferSize < FrameSize)) then
- Exit;
-
- // no valid frame -> fill with 0
- if ((Frame = nil) or (FrameSize <= 0)) then
- begin
- FillChar(Buffer[0], BufferSize, 0);
- Exit;
- end;
-
- // number of frames to copy
- FrameCopyCount := BufferSize div FrameSize;
- // insert as many copies of frame into the buffer as possible
- for i := 0 to FrameCopyCount-1 do
- Move(Frame[0], Buffer[i*FrameSize], FrameSize);
-end;
-
-{ TAudioVoiceStream }
-
-function TAudioVoiceStream.Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean;
-begin
- Self.ChannelMap := ChannelMap;
- Self.FormatInfo := FormatInfo.Copy();
- // a voice stream is always mono, reassure the the format is correct
- Self.FormatInfo.Channels := 1;
- Result := true;
-end;
-
-destructor TAudioVoiceStream.Destroy;
-begin
- Close();
- inherited;
-end;
-
-procedure TAudioVoiceStream.Close();
-begin
- PerformOnClose();
- FreeAndNil(FormatInfo);
-end;
-
-function TAudioVoiceStream.GetAudioFormatInfo(): TAudioFormatInfo;
-begin
- Result := FormatInfo;
-end;
-
-function TAudioVoiceStream.GetLength(): real;
-begin
- Result := -1;
-end;
-
-function TAudioVoiceStream.GetPosition(): real;
-begin
- Result := -1;
-end;
-
-procedure TAudioVoiceStream.SetPosition(Time: real);
-begin
-end;
-
-function TAudioVoiceStream.GetLoop(): boolean;
-begin
- Result := false;
-end;
-
-procedure TAudioVoiceStream.SetLoop(Enabled: boolean);
-begin
-end;
-
-
-end.
diff --git a/src/base/UNote.pas b/src/base/UNote.pas
deleted file mode 100644
index 8e5b709a..00000000
--- a/src/base/UNote.pas
+++ /dev/null
@@ -1,591 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UNote;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- SysUtils,
- Classes,
- SDL,
- UMusic,
- URecord,
- UTime,
- UDisplay,
- UIni,
- ULog,
- ULyrics,
- UScreenSing,
- USong,
- gl;
-
-type
- PPLayerNote = ^TPlayerNote;
- TPlayerNote = record
- Start: integer;
- Length: integer;
- Detect: real; // accurate place, detected in the note
- Tone: real;
- Perfect: boolean; // true if the note matches the original one, light the star
- Hit: boolean; // true if the note hits the line
- end;
-
- PPLayer = ^TPlayer;
- TPlayer = record
- Name: UTF8String;
-
- // Index in Teaminfo record
- TeamID: byte;
- PlayerID: byte;
-
- // Scores
- Score: real;
- ScoreLine: real;
- ScoreGolden: real;
-
- ScoreInt: integer;
- ScoreLineInt: integer;
- ScoreGoldenInt: integer;
- ScoreTotalInt: integer;
-
- // LineBonus
- ScoreLast: real; // Last Line Score
-
- // PerfectLineTwinkle (effect)
- LastSentencePerfect: boolean;
-
- HighNote: integer; // index of last note (= High(Note)?)
- LengthNote: integer; // number of notes (= Length(Note)?).
- Note: array of TPlayerNote;
- end;
-
-var
-
- // player and music info
- Player: array of TPlayer;
- PlayersPlay: integer;
-
- CurrentSong: TSong;
-
-const
- MAX_SONG_SCORE = 10000; // max. achievable points per song
- MAX_SONG_LINE_BONUS = 1000; // max. achievable line bonus per song
-
-procedure Sing(Screen: TScreenSing);
-procedure NewSentence(Screen: TScreenSing);
-procedure NewBeatClick(Screen: TScreenSing); // executed when on then new beat for click
-procedure NewBeatDetect(Screen: TScreenSing); // executed when on then new beat for detection
-procedure NewNote(Screen: TScreenSing); // detect note
-function GetMidBeat(Time: real): real;
-function GetTimeFromBeat(Beat: integer): real;
-
-implementation
-
-uses
- Math,
- StrUtils,
- USongs,
- UJoystick,
- UCommandLine,
- ULanguage,
- //SDL_ttf,
- USkins,
- UCovers,
- UCatCovers,
- UDataBase,
- UPlaylist,
- UDLLManager,
- UParty,
- UConfig,
- UCommon,
- UGraphic,
- UGraphicClasses,
- UPathUtils,
- UPlatform,
- UThemes;
-
-function GetTimeForBeats(BPM, Beats: real): real;
-begin
- Result := 60 / BPM * Beats;
-end;
-
-function GetBeats(BPM, msTime: real): real;
-begin
- Result := BPM * msTime / 60;
-end;
-
-procedure GetMidBeatSub(BPMNum: integer; var Time: real; var CurBeat: real);
-var
- NewTime: real;
-begin
- if High(CurrentSong.BPM) = BPMNum then
- begin
- // last BPM
- CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time);
- Time := 0;
- end
- else
- begin
- // not last BPM
- // count how much time is it for start of the new BPM and store it in NewTime
- NewTime := GetTimeForBeats(CurrentSong.BPM[BPMNum].BPM, CurrentSong.BPM[BPMNum+1].StartBeat - CurrentSong.BPM[BPMNum].StartBeat);
-
- // compare it to remaining time
- if (Time - NewTime) > 0 then
- begin
- // there is still remaining time
- CurBeat := CurrentSong.BPM[BPMNum].StartBeat;
- Time := Time - NewTime;
- end
- else
- begin
- // there is no remaining time
- CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time);
- Time := 0;
- end; // if
- end; // if
-end;
-
-function GetMidBeat(Time: real): real;
-var
- CurBeat: real;
- CurBPM: integer;
-begin
- // static BPM
- if Length(CurrentSong.BPM) = 1 then
- begin
- Result := Time * CurrentSong.BPM[0].BPM / 60;
- end
- // variable BPM
- else if Length(CurrentSong.BPM) > 1 then
- begin
- CurBeat := 0;
- CurBPM := 0;
- while (Time > 0) do
- begin
- GetMidBeatSub(CurBPM, Time, CurBeat);
- Inc(CurBPM);
- end;
-
- Result := CurBeat;
- end
- // invalid BPM
- else
- begin
- Result := 0;
- end;
-end;
-
-function GetTimeFromBeat(Beat: integer): real;
-var
- CurBPM: integer;
-begin
- // static BPM
- if Length(CurrentSong.BPM) = 1 then
- begin
- Result := CurrentSong.GAP / 1000 + Beat * 60 / CurrentSong.BPM[0].BPM;
- end
- // variable BPM
- else if Length(CurrentSong.BPM) > 1 then
- begin
- Result := CurrentSong.GAP / 1000;
- CurBPM := 0;
- while (CurBPM <= High(CurrentSong.BPM)) and
- (Beat > CurrentSong.BPM[CurBPM].StartBeat) do
- begin
- if (CurBPM < High(CurrentSong.BPM)) and
- (Beat >= CurrentSong.BPM[CurBPM+1].StartBeat) then
- begin
- // full range
- Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) *
- (CurrentSong.BPM[CurBPM+1].StartBeat - CurrentSong.BPM[CurBPM].StartBeat);
- end;
-
- if (CurBPM = High(CurrentSong.BPM)) or
- (Beat < CurrentSong.BPM[CurBPM+1].StartBeat) then
- begin
- // in the middle
- Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) *
- (Beat - CurrentSong.BPM[CurBPM].StartBeat);
- end;
- Inc(CurBPM);
- end;
-
- {
- while (Time > 0) do
- begin
- GetMidBeatSub(CurBPM, Time, CurBeat);
- Inc(CurBPM);
- end;
- }
- end
- // invalid BPM
- else
- begin
- Result := 0;
- end;
-end;
-
-procedure Sing(Screen: TScreenSing);
-var
- Count: integer;
- CountGr: integer;
- CP: integer;
-begin
- LyricsState.UpdateBeats();
-
- // sentences routines
- for CountGr := 0 to 0 do //High(Lines)
- begin;
- CP := CountGr;
- // old parts
- LyricsState.OldLine := Lines[CP].Current;
-
- // choose current parts
- for Count := 0 to Lines[CP].High do
- begin
- if LyricsState.CurrentBeat >= Lines[CP].Line[Count].Start then
- Lines[CP].Current := Count;
- end;
-
- // clean player note if there is a new line
- // (optimization on halfbeat time)
- if Lines[CP].Current <> LyricsState.OldLine then
- NewSentence(Screen);
-
- end; // for CountGr
-
- // make some operations on clicks
- if {(LyricsState.CurrentBeatC >= 0) and }(LyricsState.OldBeatC <> LyricsState.CurrentBeatC) then
- NewBeatClick(Screen);
-
- // make some operations when detecting new voice pitch
- if (LyricsState.CurrentBeatD >= 0) and (LyricsState.OldBeatD <> LyricsState.CurrentBeatD) then
- NewBeatDetect(Screen);
-end;
-
-procedure NewSentence(Screen: TScreenSing);
-var
- i: integer;
-begin
- // clean note of player
- for i := 0 to High(Player) do
- begin
- Player[i].LengthNote := 0;
- Player[i].HighNote := -1;
- SetLength(Player[i].Note, 0);
- end;
-
- // on sentence change...
- Screen.onSentenceChange(Lines[0].Current);
-end;
-
-procedure NewBeatClick;
-var
- Count: integer;
-begin
- // beat click
- if ((Ini.BeatClick = 1) and
- ((LyricsState.CurrentBeatC + Lines[0].Resolution + Lines[0].NotesGAP) mod Lines[0].Resolution = 0)) then
- begin
- AudioPlayback.PlaySound(SoundLib.Click);
- end;
-
- for Count := 0 to Lines[0].Line[Lines[0].Current].HighNote do
- begin
- if (Lines[0].Line[Lines[0].Current].Note[Count].Start = LyricsState.CurrentBeatC) then
- begin
- // click assist
- if Ini.ClickAssist = 1 then
- AudioPlayback.PlaySound(SoundLib.Click);
-
- // drum machine
- (*
- TempBeat := LyricsState.CurrentBeat; // + 2;
- if (TempBeat mod 8 = 0) then Music.PlayDrum;
- if (TempBeat mod 8 = 4) then Music.PlayClap;
- //if (TempBeat mod 4 = 2) then Music.PlayHihat;
- if (TempBeat mod 4 <> 0) then Music.PlayHihat;
- *)
- end;
- end;
-end;
-
-procedure NewBeatDetect(Screen: TScreenSing);
-begin
- NewNote(Screen);
-end;
-
-procedure NewNote(Screen: TScreenSing);
-var
- LineFragmentIndex: integer;
- CurrentLineFragment: PLineFragment;
- PlayerIndex: integer;
- CurrentSound: TCaptureBuffer;
- CurrentPlayer: PPlayer;
- LastPlayerNote: PPlayerNote;
- Line: PLine;
- SentenceIndex: integer;
- SentenceMin: integer;
- SentenceMax: integer;
- SentenceDetected: integer; // sentence of detected note
- NoteAvailable: boolean;
- NewNote: boolean;
- Range: integer;
- NoteHit: boolean;
- MaxSongPoints: integer; // max. points for the song (without line bonus)
- CurNotePoints: real; // Points for the cur. Note (PointsperNote * ScoreFactor[CurNote])
-begin
- // TODO: add duet mode support
- // use Lines[LineSetIndex] with LineSetIndex depending on the current player
-
- // count min and max sentence range for checking
- // (detection is delayed to the notes we see on the screen)
- SentenceMin := Lines[0].Current-1;
- if (SentenceMin < 0) then
- SentenceMin := 0;
- SentenceMax := Lines[0].Current;
-
- // check for an active note at the current time defined in the lyrics
- NoteAvailable := false;
- SentenceDetected := SentenceMin;
- for SentenceIndex := SentenceMin to SentenceMax do
- begin
- Line := @Lines[0].Line[SentenceIndex];
- for LineFragmentIndex := 0 to Line.HighNote do
- begin
- CurrentLineFragment := @Line.Note[LineFragmentIndex];
- // check if line is active
- if ((CurrentLineFragment.Start <= LyricsState.CurrentBeatD) and
- (CurrentLineFragment.Start + CurrentLineFragment.Length-1 >= LyricsState.CurrentBeatD)) and
- (CurrentLineFragment.NoteType <> ntFreestyle) and // but ignore FreeStyle notes
- (CurrentLineFragment.Length > 0) then // and make sure the note length is at least 1
- begin
- SentenceDetected := SentenceIndex;
- NoteAvailable := true;
- Break;
- end;
- end;
- // TODO: break here, if NoteAvailable is true? We would then use the first instead
- // of the last note matching the current beat if notes overlap. But notes
- // should not overlap at all.
- // if (NoteAvailable) then
- // Break;
- end;
-
- // analyze player signals
- for PlayerIndex := 0 to PlayersPlay-1 do
- begin
- CurrentPlayer := @Player[PlayerIndex];
- CurrentSound := AudioInputProcessor.Sound[PlayerIndex];
-
- // at the beginning of the song there is no previous note
- if (Length(CurrentPlayer.Note) > 0) then
- LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote]
- else
- LastPlayerNote := nil;
-
- // analyze buffer
- CurrentSound.AnalyzeBuffer;
-
- // add some noise
- // TODO: do we need this?
- //LyricsState.Tone := LyricsState.Tone + Round(Random(3)) - 1;
-
- // add note if possible
- if (CurrentSound.ToneValid and NoteAvailable) then
- begin
- Line := @Lines[0].Line[SentenceDetected];
-
- // process until last note
- for LineFragmentIndex := 0 to Line.HighNote do
- begin
- CurrentLineFragment := @Line.Note[LineFragmentIndex];
- if (CurrentLineFragment.Start <= LyricsState.OldBeatD+1) and
- (CurrentLineFragment.Start + CurrentLineFragment.Length > LyricsState.OldBeatD+1) then
- begin
- // compare notes (from song-file and from player)
-
- // move players tone to proper octave
- while (CurrentSound.Tone - CurrentLineFragment.Tone > 6) do
- CurrentSound.Tone := CurrentSound.Tone - 12;
-
- while (CurrentSound.Tone - CurrentLineFragment.Tone < -6) do
- CurrentSound.Tone := CurrentSound.Tone + 12;
-
- // half size notes patch
- NoteHit := false;
-
- // if Ini.Difficulty = 0 then Range := 2;
- // if Ini.Difficulty = 1 then Range := 1;
- // if Ini.Difficulty = 2 then Range := 0;
- Range := 2 - Ini.Difficulty;
-
- // check if the player hit the correct tone within the tolerated range
- if (Abs(CurrentLineFragment.Tone - CurrentSound.Tone) <= Range) then
- begin
- // adjust the players tone to the correct one
- // TODO: do we need to do this?
- // Philipp: I think we do, at least when we draw the notes.
- // Otherwise the notehit thing would be shifted to the
- // correct unhit note. I think this will look kind of strange.
- CurrentSound.Tone := CurrentLineFragment.Tone;
-
- // half size notes patch
- NoteHit := true;
-
- if (Ini.LineBonus > 0) then
- MaxSongPoints := MAX_SONG_SCORE - MAX_SONG_LINE_BONUS
- else
- MaxSongPoints := MAX_SONG_SCORE;
-
- // Note: ScoreValue is the sum of all note values of the song
- // (MaxSongPoints / ScoreValue) is the points that a player
- // gets for a hit of one beat of a normal note
- // CurNotePoints is the amount of points that is meassured
- // for a hit of the note per full beat
- CurNotePoints := (MaxSongPoints / Lines[0].ScoreValue) * ScoreFactor[CurrentLineFragment.NoteType];
-
- case CurrentLineFragment.NoteType of
- ntNormal: CurrentPlayer.Score := CurrentPlayer.Score + CurNotePoints;
- ntGolden: CurrentPlayer.ScoreGolden := CurrentPlayer.ScoreGolden + CurNotePoints;
- end;
-
- // a problem if we use floor instead of round is that a score of
- // 10000 points is only possible if the last digit of the total points
- // for golden and normal notes is 0.
- // if we use round, the max score is 10000 for most songs
- // but a score of 10010 is possible if the last digit of the total
- // points for golden and normal notes is 5
- // the best solution is to use round for one of these scores
- // and round the other score in the opposite direction
- // so we assure that the highest possible score is 10000 in every case.
- CurrentPlayer.ScoreInt := round(CurrentPlayer.Score / 10) * 10;
-
- if (CurrentPlayer.ScoreInt < CurrentPlayer.Score) then
- //normal score is floored so we have to ceil golden notes score
- CurrentPlayer.ScoreGoldenInt := ceil(CurrentPlayer.ScoreGolden / 10) * 10
- else
- //normal score is ceiled so we have to floor golden notes score
- CurrentPlayer.ScoreGoldenInt := floor(CurrentPlayer.ScoreGolden / 10) * 10;
-
-
- CurrentPlayer.ScoreTotalInt := CurrentPlayer.ScoreInt +
- CurrentPlayer.ScoreGoldenInt +
- CurrentPlayer.ScoreLineInt;
- end;
-
- end; // operation
- end; // for
-
- // check if we have to add a new note or extend the note's length
- if (SentenceDetected = SentenceMax) then
- begin
- // we will add a new note
- NewNote := true;
-
- // if previous note (if any) was the same, extend previous note
- if ((CurrentPlayer.LengthNote > 0) and
- (LastPlayerNote <> nil) and
- (LastPlayerNote.Tone = CurrentSound.Tone) and
- ((LastPlayerNote.Start + LastPlayerNote.Length) = LyricsState.CurrentBeatD)) then
- begin
- NewNote := false;
- end;
-
- // if is not as new note to control
- for LineFragmentIndex := 0 to Line.HighNote do
- begin
- if (Line.Note[LineFragmentIndex].Start = LyricsState.CurrentBeatD) then
- NewNote := true;
- end;
-
- // add new note
- if NewNote then
- begin
- // new note
- Inc(CurrentPlayer.LengthNote);
- Inc(CurrentPlayer.HighNote);
- SetLength(CurrentPlayer.Note, CurrentPlayer.LengthNote);
-
- // update player's last note
- LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote];
- with LastPlayerNote^ do
- begin
- Start := LyricsState.CurrentBeatD;
- Length := 1;
- Tone := CurrentSound.Tone; // Tone || ToneAbs
- Detect := LyricsState.MidBeat;
- Hit := NoteHit; // half note patch
- end;
- end
- else
- begin
- // extend note length
- if (LastPlayerNote <> nil) then
- Inc(LastPlayerNote.Length);
- end;
-
- // check for perfect note and then light the star (on Draw)
- for LineFragmentIndex := 0 to Line.HighNote do
- begin
- CurrentLineFragment := @Line.Note[LineFragmentIndex];
- if (CurrentLineFragment.Start = LastPlayerNote.Start) and
- (CurrentLineFragment.Length = LastPlayerNote.Length) and
- (CurrentLineFragment.Tone = LastPlayerNote.Tone) then
- begin
- LastPlayerNote.Perfect := true;
- end;
- end;
- end; // if SentenceDetected = SentenceMax
-
- end; // if Detected
- end; // for PlayerIndex
-
- //Log.LogStatus('EndBeat', 'NewBeat');
-
- // on sentence end -> for LineBonus and display of SingBar (rating pop-up)
- if (SentenceDetected >= Low(Lines[0].Line)) and
- (SentenceDetected <= High(Lines[0].Line)) then
- begin
- Line := @Lines[0].Line[SentenceDetected];
- CurrentLineFragment := @Line.Note[Line.HighNote];
- if ((CurrentLineFragment.Start + CurrentLineFragment.Length - 1) = LyricsState.CurrentBeatD) then
- begin
- if assigned(Screen) then
- Screen.OnSentenceEnd(SentenceDetected);
- end;
- end;
-
-end;
-
-end.
diff --git a/src/base/UParty.pas b/src/base/UParty.pas
deleted file mode 100644
index 52eb5a05..00000000
--- a/src/base/UParty.pas
+++ /dev/null
@@ -1,388 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UParty;
-
-interface
-
-{$IFDEF FPC}
- {$MODE DELPHI}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- ModiSDK;
-
-type
- TRoundInfo = record
- Plugin: word;
- Winner: byte;
- end;
-
- TeamOrderEntry = record
- TeamNum: byte;
- Score: byte;
- end;
-
- TeamOrderArray = array[0..5] of byte;
-
- TPartyPlugin = record
- ID: byte;
- TimesPlayed: byte;
- end;
-
- TPartySession = class
- private
- function GetRandomPlayer(Team: byte): byte;
- function GetRandomPlugin(Plugins: array of TPartyPlugin): byte;
- function IsWinner(Player, Winner: byte): boolean;
- procedure GenScores;
- public
- Teams: TTeamInfo;
- Rounds: array of TRoundInfo;
- CurRound: byte;
-
- constructor Create;
-
- procedure StartNewParty(NumRounds: byte);
- procedure StartRound;
- procedure EndRound;
- function GetTeamOrder: TeamOrderArray;
- function GetWinnerString(Round: byte): UTF8String;
- end;
-
-var
- PartySession: TPartySession;
-
-implementation
-
-uses
- UDLLManager,
- UGraphic,
- UNote,
- ULanguage,
- ULog;
-
-constructor TPartySession.Create;
-begin
- inherited;
-end;
-
-//----------
-// Returns a number of a random plugin
-//----------
-function TPartySession.GetRandomPlugin(Plugins: array of TPartyPlugin): byte;
-var
- LowestTP: byte;
- NumPwithLTP: word;
- I: integer;
- R: word;
-begin
- LowestTP := high(byte);
- NumPwithLTP := 0;
-
- //Search for Plugins not often played yet
- for I := 0 to high(Plugins) do
- begin
- if (Plugins[I].TimesPlayed < lowestTP) then
- begin
- lowestTP := Plugins[I].TimesPlayed;
- NumPwithLTP := 1;
- end
- else if (Plugins[I].TimesPlayed = lowestTP) then
- begin
- Inc(NumPwithLTP);
- end;
- end;
-
- //Create random no
- R := Random(NumPwithLTP);
-
- //Search for random plugin
- for I := 0 to high(Plugins) do
- begin
- if Plugins[I].TimesPlayed = LowestTP then
- begin
- //Plugin found
- if (R = 0) then
- begin
- Result := Plugins[I].ID;
- Inc(Plugins[I].TimesPlayed);
- Break;
- end;
- Dec(R);
- end;
- end;
-end;
-
-//----------
-//StartNewParty - Reset and prepares for new party
-//----------
-procedure TPartySession.StartNewParty(NumRounds: byte);
-var
- Plugins: array of TPartyPlugin;
- TeamMode: boolean;
- Len: integer;
- I, J: integer;
-begin
- //Set current round to 1
- CurRound := 255;
-
- PlayersPlay := Teams.NumTeams;
-
- //Get team-mode and set joker, also set TimesPlayed
- TeamMode := true;
- for I := 0 to Teams.NumTeams - 1 do
- begin
- if Teams.Teaminfo[I].NumPlayers < 2 then
- begin
- TeamMode := false;
- end;
- //Set player attributes
- for J := 0 to Teams.TeamInfo[I].NumPlayers-1 do
- begin
- Teams.TeamInfo[I].Playerinfo[J].TimesPlayed := 0;
- end;
- Teams.Teaminfo[I].Joker := Round(NumRounds * 0.7);
- Teams.Teaminfo[I].Score := 0;
- end;
-
- //Fill plugin array
- SetLength(Plugins, 0);
- for I := 0 to high(DLLMan.Plugins) do
- begin
- if TeamMode or (not DLLMan.Plugins[I].TeamModeOnly) then
- begin
- //Add only those plugins playable with current PlayerConfiguration
- Len := Length(Plugins);
- SetLength(Plugins, Len + 1);
- Plugins[Len].ID := I;
- Plugins[Len].TimesPlayed := 0;
- end;
- end;
-
- //Set rounds
- if (Length(Plugins) >= 1) then
- begin
- SetLength (Rounds, NumRounds);
- for I := 0 to NumRounds - 1 do
- begin
- PartySession.Rounds[I].Plugin := GetRandomPlugin(Plugins);
- PartySession.Rounds[I].Winner := 255;
- end;
- end
- else
- SetLength (Rounds, 0);
-end;
-
-{**
- * Returns a random player to play next round
- *}
-function TPartySession.GetRandomPlayer(Team: byte): byte;
-var
- I, R: integer;
- LowestTP: byte;
- NumPwithLTP: byte;
-begin
- LowestTP := high(byte);
- NumPwithLTP := 0;
- Result := 0;
-
- //Search for players that have not often played yet
- for I := 0 to Teams.Teaminfo[Team].NumPlayers - 1 do
- begin
- if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then
- begin
- lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed;
- NumPwithLTP := 1;
- end
- else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then
- begin
- Inc(NumPwithLTP);
- end;
- end;
-
- //Create random number
- R := Random(NumPwithLTP);
-
- //Search for random player
- for I := 0 to Teams.Teaminfo[Team].NumPlayers - 1 do
- begin
- if Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP then
- begin
- //Player found
- if (R = 0) then
- begin
- Result := I;
- Break;
- end;
-
- Dec(R);
- end;
- end;
-end;
-
-{**
- * Prepares ScreenSingModi for next round and loads plugin
- *}
-procedure TPartySession.StartRound;
-var
- I: integer;
-begin
- if ((CurRound < high(Rounds)) or (CurRound = high(CurRound))) then
- begin
- // Increase Current Round but not beyond its limit
- // CurRound is set to 255 to begin with!
- // Ugly solution if you ask me.
- if CurRound < high(CurRound) then
- Inc(CurRound)
- else
- CurRound := 0;
-
- Rounds[CurRound].Winner := 255;
- DllMan.LoadPlugin(Rounds[CurRound].Plugin);
-
- //Select Players
- for I := 0 to Teams.NumTeams - 1 do
- Teams.Teaminfo[I].CurPlayer := GetRandomPlayer(I);
-
- //Set ScreenSingModie Variables
- ScreenSingModi.TeamInfo := Teams;
- end;
-end;
-
-//----------
-//EndRound - Get Winner from ScreenSingModi and Save Data to RoundArray
-//----------
-procedure TPartySession.EndRound;
-var
- I: Integer;
-begin
- //Copy Winner
- Rounds[CurRound].Winner := ScreenSingModi.Winner;
- //Set Scores
- GenScores;
-
- //Increase TimesPlayed 4 all Players
- For I := 0 to Teams.NumTeams-1 do
- Inc(Teams.Teaminfo[I].Playerinfo[Teams.Teaminfo[I].CurPlayer].TimesPlayed);
-
-end;
-
-//----------
-//IsWinner - returns true if the player's bit is set in the winner byte
-//----------
-function TPartySession.IsWinner(Player, Winner: byte): boolean;
-var
- Mask: byte;
-begin
- Mask := 1 shl Player;
- Result := (Winner and Mask) <> 0;
-end;
-
-//----------
-//GenScores - increase scores for current round
-//----------
-procedure TPartySession.GenScores;
-var
- I: byte;
-begin
- for I := 0 to Teams.NumTeams - 1 do
- begin
- if isWinner(I, Rounds[CurRound].Winner) then
- Inc(Teams.Teaminfo[I].Score);
- end;
-end;
-
-//----------
-//GetTeamOrder - returns the placement of each Team [First Position of Array is Teamnum of first placed Team, ...]
-//----------
-function TPartySession.GetTeamOrder: TeamOrderArray;
-var
- I, J: integer;
- ATeams: array [0..5] of TeamOrderEntry;
- TempTeam: TeamOrderEntry;
-begin
- // TODO: PartyMode: Write this in another way, so that teams with the same score get the same place
- //Fill Team array
- for I := 0 to Teams.NumTeams - 1 do
- begin
- ATeams[I].Teamnum := I;
- ATeams[I].Score := Teams.Teaminfo[I].Score;
- end;
-
- //Sort teams
- for J := 0 to Teams.NumTeams - 1 do
- for I := 1 to Teams.NumTeams - 1 do
- if ATeams[I].Score > ATeams[I-1].Score then
- begin
- TempTeam := ATeams[I-1];
- ATeams[I-1] := ATeams[I];
- ATeams[I] := TempTeam;
- end;
-
- //Copy to Result
- for I := 0 to Teams.NumTeams-1 do
- Result[I] := ATeams[I].TeamNum;
-end;
-
-//----------
-//GetWinnerString - Get string with WinnerTeam Name, when there is more than one Winner than Connect with and or ,
-//----------
-function TPartySession.GetWinnerString(Round: byte): UTF8String;
-var
- Winners: array of UTF8String;
- I: integer;
-begin
- Result := Language.Translate('PARTY_NOBODY');
-
- if (Round > High(Rounds)) then
- exit;
-
- if (Rounds[Round].Winner = 0) then
- begin
- exit;
- end;
-
- if (Rounds[Round].Winner = 255) then
- begin
- Result := Language.Translate('PARTY_NOTPLAYEDYET');
- exit;
- end;
-
- SetLength(Winners, 0);
- for I := 0 to Teams.NumTeams - 1 do
- begin
- if isWinner(I, Rounds[Round].Winner) then
- begin
- SetLength(Winners, Length(Winners) + 1);
- Winners[high(Winners)] := Teams.TeamInfo[I].Name;
- end;
- end;
- Result := Language.Implode(Winners);
-end;
-
-end.
diff --git a/src/base/UPathUtils.pas b/src/base/UPathUtils.pas
deleted file mode 100644
index c2bcdd4b..00000000
--- a/src/base/UPathUtils.pas
+++ /dev/null
@@ -1,196 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UPathUtils;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- SysUtils,
- Classes,
- UPath;
-
-var
- // Absolute Paths
- GamePath: IPath;
- SoundPath: IPath;
- SongPaths: IInterfaceList;
- LogPath: IPath;
- ThemePath: IPath;
- SkinsPath: IPath;
- ScreenshotsPath: IPath;
- CoverPaths: IInterfaceList;
- LanguagesPath: IPath;
- PluginPath: IPath;
- VisualsPath: IPath;
- FontPath: IPath;
- ResourcesPath: IPath;
- PlaylistPath: IPath;
-
-function FindPath(out PathResult: IPath; const RequestedPath: IPath; NeedsWritePermission: boolean): boolean;
-procedure InitializePaths;
-procedure AddSongPath(const Path: IPath);
-
-implementation
-
-uses
- StrUtils,
- UPlatform,
- UCommandLine,
- ULog;
-
-procedure AddSpecialPath(var PathList: IInterfaceList; const Path: IPath);
-var
- Index: integer;
- PathAbs, PathTmp: IPath;
- OldPath, OldPathAbs, OldPathTmp: IPath;
-begin
- if (PathList = nil) then
- PathList := TInterfaceList.Create;
-
- if Path.Equals(PATH_NONE) or not Path.CreateDirectory(true) then
- Exit;
-
- PathTmp := Path.GetAbsolutePath();
- PathAbs := PathTmp.AppendPathDelim();
-
- // check if path or a part of the path was already added
- for Index := 0 to PathList.Count-1 do
- begin
- OldPath := PathList[Index] as IPath;
- OldPathTmp := OldPath.GetAbsolutePath();
- OldPathAbs := OldPathTmp.AppendPathDelim();
-
- // check if the new directory is a sub-directory of a previously added one.
- // This is also true, if both paths point to the same directories.
- if (OldPathAbs.IsChildOf(PathAbs, false) or OldPathAbs.Equals(PathAbs)) then
- begin
- // ignore the new path
- Exit;
- end;
-
- // check if a previously added directory is a sub-directory of the new one.
- if (PathAbs.IsChildOf(OldPathAbs, false)) then
- begin
- // replace the old with the new one.
- PathList[Index] := PathAbs;
- Exit;
- end;
- end;
-
- PathList.Add(PathAbs);
-end;
-
-procedure AddSongPath(const Path: IPath);
-begin
- AddSpecialPath(SongPaths, Path);
-end;
-
-procedure AddCoverPath(const Path: IPath);
-begin
- AddSpecialPath(CoverPaths, Path);
-end;
-
-(**
- * Initialize a path variable
- * After setting paths, make sure that paths exist
- *)
-function FindPath(
- out PathResult: IPath;
- const RequestedPath: IPath;
- NeedsWritePermission: boolean): boolean;
-begin
- Result := false;
-
- if (RequestedPath.Equals(PATH_NONE)) then
- Exit;
-
- // Make sure the directory exists
- if (not RequestedPath.CreateDirectory(true)) then
- begin
- PathResult := PATH_NONE;
- Exit;
- end;
-
- PathResult := RequestedPath.AppendPathDelim();
-
- if (NeedsWritePermission) and RequestedPath.IsReadOnly() then
- Exit;
-
- Result := true;
-end;
-
-(**
- * Function sets all absolute paths e.g. song path and makes sure the directorys exist
- *)
-procedure InitializePaths;
-var
- SharedPath, UserPath: IPath;
-begin
- // Log directory (must be writable)
- if (not FindPath(LogPath, Platform.GetLogPath, true)) then
- begin
- Log.FileOutputEnabled := false;
- Log.LogWarn('Log directory "'+ Platform.GetLogPath.ToNative +'" not available', 'InitializePaths');
- end;
-
- SharedPath := Platform.GetGameSharedPath;
- UserPath := Platform.GetGameUserPath;
-
- FindPath(SoundPath, SharedPath.Append('sounds'), false);
- FindPath(ThemePath, SharedPath.Append('themes'), false);
- FindPath(SkinsPath, SharedPath.Append('themes'), false);
- FindPath(LanguagesPath, SharedPath.Append('languages'), false);
- FindPath(PluginPath, SharedPath.Append('plugins'), false);
- FindPath(VisualsPath, SharedPath.Append('visuals'), false);
- FindPath(FontPath, SharedPath.Append('fonts'), false);
- FindPath(ResourcesPath, SharedPath.Append('resources'), false);
-
- // Playlists are not shared as we need one directory to write too
- FindPath(PlaylistPath, UserPath.Append('playlists'), true);
-
- // Screenshot directory (must be writable)
- if (not FindPath(ScreenshotsPath, UserPath.Append('screenshots'), true)) then
- begin
- Log.LogWarn('Screenshot directory "'+ UserPath.ToNative +'" not available', 'InitializePaths');
- end;
-
- // Add song paths
- AddSongPath(Params.SongPath);
- AddSongPath(SharedPath.Append('songs'));
- AddSongPath(UserPath.Append('songs'));
-
- // Add category cover paths
- AddCoverPath(SharedPath.Append('covers'));
- AddCoverPath(UserPath.Append('covers'));
-end;
-
-end.
diff --git a/src/base/UPlatform.pas b/src/base/UPlatform.pas
deleted file mode 100644
index 11c67fa7..00000000
--- a/src/base/UPlatform.pas
+++ /dev/null
@@ -1,135 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UPlatform;
-
-// Comment by Eddie:
-// This unit defines an interface for platform specific utility functions.
-// The Interface is implemented in separate files for each platform:
-// UPlatformWindows, UPlatformLinux and UPlatformMacOSX.
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- Classes,
- UPath;
-
-type
- TPlatform = class
- function GetExecutionDir(): IPath;
- procedure Init; virtual;
-
- function TerminateIfAlreadyRunning(var WndTitle: string): boolean; virtual;
- procedure Halt; virtual;
-
- function GetLogPath: IPath; virtual; abstract;
- function GetGameSharedPath: IPath; virtual; abstract;
- function GetGameUserPath: IPath; virtual; abstract;
- end;
-
- function Platform(): TPlatform;
-
-implementation
-
-uses
- SysUtils,
- {$IF Defined(MSWINDOWS)}
- UPlatformWindows,
- {$ELSEIF Defined(DARWIN)}
- UPlatformMacOSX,
- {$ELSEIF Defined(UNIX)}
- UPlatformLinux,
- {$IFEND}
- ULog,
- UUnicodeUtils,
- UFilesystem;
-
-
-// I modified it to use the Platform_singleton in this location (in the implementation)
-// so that this variable can NOT be overwritten from anywhere else in the application.
-// the accessor function platform, emulates all previous calls to work the same way.
-var
- Platform_singleton: TPlatform;
-
-function Platform: TPlatform;
-begin
- Result := Platform_singleton;
-end;
-
-(**
- * Default Init() implementation
- *)
-procedure TPlatform.Init;
-begin
-end;
-
-(**
- * Default Halt() implementation
- *)
-procedure TPlatform.Halt;
-begin
- // Note: Application.terminate is NOT the same
- System.Halt;
-end;
-
-{**
- * Returns the directory of the executable
- *}
-function TPlatform.GetExecutionDir(): IPath;
-var
- ExecName, ExecDir: IPath;
-begin
- ExecName := Path(ParamStr(0));
- ExecDir := ExecName.GetPath;
- Result := ExecDir.GetAbsolutePath();
-end;
-
-(**
- * Default TerminateIfAlreadyRunning() implementation
- *)
-function TPlatform.TerminateIfAlreadyRunning(var WndTitle: string): boolean;
-begin
- Result := false;
-end;
-
-initialization
-{$IF Defined(MSWINDOWS)}
- Platform_singleton := TPlatformWindows.Create;
-{$ELSEIF Defined(DARWIN)}
- Platform_singleton := TPlatformMacOSX.Create;
-{$ELSEIF Defined(UNIX)}
- Platform_singleton := TPlatformLinux.Create;
-{$IFEND}
-
-finalization
- Platform_singleton.Free;
-
-end.
diff --git a/src/base/UPlatformLinux.pas b/src/base/UPlatformLinux.pas
deleted file mode 100644
index 693facaa..00000000
--- a/src/base/UPlatformLinux.pas
+++ /dev/null
@@ -1,149 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UPlatformLinux;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- Classes,
- UPlatform,
- UConfig,
- UPath;
-
-type
- TPlatformLinux = class(TPlatform)
- private
- UseLocalDirs: boolean;
-
- procedure DetectLocalExecution();
- function GetHomeDir(): IPath;
- public
- procedure Init; override;
-
- function GetLogPath : IPath; override;
- function GetGameSharedPath : IPath; override;
- function GetGameUserPath : IPath; override;
- end;
-
-implementation
-
-uses
- UCommandLine,
- BaseUnix,
- pwd,
- SysUtils,
- ULog;
-
-const
- {$I paths.inc}
-
-procedure TPlatformLinux.Init;
-begin
- inherited Init();
- DetectLocalExecution();
-end;
-
-{**
- * Detects whether the game was executed locally or globally.
- * - It is local if it was not installed and directly executed from
- * within the game folder. In this case resources (themes, language-files)
- * reside in the directory of the executable.
- * - It is global if the game was installed (e.g. to /usr/bin) and
- * the resources are in a separate folder (e.g. /usr/share/ultrastardx)
- * which name is stored in the INSTALL_DATADIR constant in paths.inc.
- *
- * Sets UseLocalDirs to true if the game is executed locally, false otherwise.
- *}
-procedure TPlatformLinux.DetectLocalExecution();
-var
- LocalDir, LanguageDir: IPath;
-begin
- // we just check if the 'languages' folder exists in the
- // directory of the executable. If so -> local execution.
- LocalDir := GetExecutionDir();
- LanguageDir := LocalDir.Append('languages');
- UseLocalDirs := LanguageDir.IsDirectory;
-end;
-
-function TPlatformLinux.GetLogPath: IPath;
-begin
- if UseLocalDirs then
- Result := GetExecutionDir()
- else
- Result := GetGameUserPath().Append('logs', pdAppend);
-
- // create non-existing directories
- Result.CreateDirectory(true);
-end;
-
-function TPlatformLinux.GetGameSharedPath: IPath;
-begin
- if UseLocalDirs then
- Result := GetExecutionDir()
- else
- Result := Path(INSTALL_DATADIR, pdAppend);
-end;
-
-function TPlatformLinux.GetGameUserPath: IPath;
-begin
- if UseLocalDirs then
- Result := GetExecutionDir()
- else
- Result := GetHomeDir().Append('.ultrastardx', pdAppend);
-end;
-
-{**
- * Returns the user's home directory terminated by a path delimiter
- *}
-function TPlatformLinux.GetHomeDir(): IPath;
-var
- PasswdEntry: PPasswd;
-begin
- Result := PATH_NONE;
-
- // try to retrieve the info from passwd
- PasswdEntry := FpGetpwuid(FpGetuid());
- if (PasswdEntry <> nil) then
- Result := Path(PasswdEntry.pw_dir);
- // fallback if passwd does not contain the path
- if (Result.IsUnset) then
- Result := Path(GetEnvironmentVariable('HOME'));
- // add trailing path delimiter (normally '/')
- if (Result.IsSet) then
- Result := Result.AppendPathDelim();
-
- // GetUserDir() is another function that returns a user path.
- // It uses env-var HOME or a fallback to a temp-dir.
- //Result := GetUserDir();
-end;
-
-end.
diff --git a/src/base/UPlatformMacOSX.pas b/src/base/UPlatformMacOSX.pas
deleted file mode 100644
index 1dc0014a..00000000
--- a/src/base/UPlatformMacOSX.pas
+++ /dev/null
@@ -1,279 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UPlatformMacOSX;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- Classes,
- ULog,
- UPlatform,
- UFilesystem,
- UPath;
-
-type
- {**
- * @abstract(Provides Mac OS X specific details.)
- * @lastmod(August 1, 2008)
- * The UPlatformMacOSX unit takes care of setting paths to resource folders.
- *
- * (Note for non-Maccies: "folder" is the Mac name for directory.)
- *
- * Note on the resource folders:
- * 1. Installation of an application on the mac works as follows: Extract and
- * copy an application and if you don't like or need the application
- * anymore you move the folder to the trash - and you're done.
- * 2. The use of folders in the user's home directory is against Apple's
- * guidelines and strange to an average user.
- * 3. Even worse is using /usr/local/... since all lowercase folders in / are
- * not visible to an average user in the Finder, at least not without some
- * "tricks".
- *
- * The best way would be to store everything within the application bundle.
- * However, this requires USDX to offer the handling of the resources. Until
- * this is implemented, the second best solution is as follows:
- *
- * According to Aple guidelines handling of resources and folders should follow
- * these lines:
- *
- * Acceptable places for files are folders named UltraStarDeluxe either in
- * /Library/Application Support/
- * or
- * ~/Library/Application Support/
- *
- * So
- * GetGameSharedPath could return
- * /Library/Application Support/UltraStarDeluxe/.
- * GetGameUserPath could return
- * ~/Library/Application Support/UltraStarDeluxe/.
- *
- * Right now, only $HOME/Library/Application Support/UltraStarDeluxe
- * is used. So every user needs the complete set of files and folders.
- * Future versions may also use shared resources in
- * /Library/Application Support/UltraStarDeluxe. However, this is
- * not treated yet in the code outside this unit.
- *
- * USDX checks, whether GetGameUserPath exists. If not, USDX creates it.
- * The existence of needed files is then checked and if a file is missing
- * it is copied to there from within the folder Contents in the Application
- * bundle, which contains the default files. USDX should not delete files or
- * folders in Application Support/UltraStarDeluxe automatically or without
- * user confirmation.
- *}
- TPlatformMacOSX = class(TPlatform)
- private
- {**
- * GetBundlePath returns the path to the application bundle
- * UltraStarDeluxe.app.
- *}
- function GetBundlePath: IPath;
-
- {**
- * GetApplicationSupportPath returns the path to
- * $HOME/Library/Application Support/UltraStarDeluxe.
- *}
- function GetApplicationSupportPath: IPath;
-
- {**
- * see the description of @link(Init).
- *}
- procedure CreateUserFolders();
-
- function GetHomeDir(): IPath;
-
- public
- {**
- * Init simply calls @link(CreateUserFolders), which in turn scans the
- * folder UltraStarDeluxe.app/Contents for all files and
- * folders. $HOME/Library/Application Support/UltraStarDeluxe
- * is then checked for their presence and missing ones are copied.
- *}
- procedure Init; override;
-
- {**
- * GetLogPath returns the path for log messages. Currently it is set to
- * $HOME/Library/Application Support/UltraStarDeluxe/Log.
- *}
- function GetLogPath : IPath; override;
-
- {**
- * GetGameSharedPath returns the path for shared resources. Currently it
- * is set to /Library/Application Support/UltraStarDeluxe.
- * However it is not used.
- *}
- function GetGameSharedPath : IPath; override;
-
- {**
- * GetGameUserPath returns the path for user resources. Currently it is
- * set to $HOME/Library/Application Support/UltraStarDeluxe.
- * This is where a user can add songs, themes, ....
- *}
- function GetGameUserPath : IPath; override;
- end;
-
-implementation
-
-uses
- SysUtils;
-
-procedure TPlatformMacOSX.Init;
-begin
- CreateUserFolders();
-end;
-
-procedure TPlatformMacOSX.CreateUserFolders();
-var
- RelativePath: IPath;
- // BaseDir contains the path to the folder, where a search is performed.
- // It is set to the entries in @link(DirectoryList) one after the other.
- BaseDir: IPath;
- // OldBaseDir contains the path to the folder, where the search started.
- // It is used to return to it, when the search is completed in all folders.
- OldBaseDir: IPath;
- Iter: IFileIterator;
- FileInfo: TFileInfo;
- CurPath: IPath;
- // These two lists contain all folder and file names found
- // within the folder @link(BaseDir).
- DirectoryList, FileList: IInterfaceList;
- // DirectoryIsFinished contains the index of the folder in @link(DirectoryList),
- // which is the last one completely searched. Later folders are still to be
- // searched for additional files and folders.
- DirectoryIsFinished: longint;
- I: longint;
- // These three are for creating directories, due to possible symlinks
- CreatedDirectory: boolean;
- FileAttrs: integer;
- DirectoryPath: IPath;
- UserPath: IPath;
- SrcFile, TgtFile: IPath;
-begin
- // Get the current folder and save it in OldBaseDir for returning to it, when
- // finished.
- OldBaseDir := FileSystem.GetCurrentDir();
-
- // UltraStarDeluxe.app/Contents contains all the default files and folders.
- BaseDir := OldBaseDir.Append('UltraStarDeluxe.app/Contents');
- FileSystem.SetCurrentDir(BaseDir);
-
- // Right now, only $HOME/Library/Application Support/UltraStarDeluxe is used.
- UserPath := GetGameUserPath();
-
- DirectoryIsFinished := 0;
- // replace with IInterfaceList
- DirectoryList := TInterfaceList.Create();
- FileList := TInterfaceList.Create();
- DirectoryList.Add(Path('.'));
-
- // create the folder and file lists
- repeat
- RelativePath := (DirectoryList[DirectoryIsFinished] as IPath);
- FileSystem.SetCurrentDir(BaseDir.Append(RelativePath));
- Iter := FileSystem.FileFind(Path('*'), faAnyFile);
- while (Iter.HasNext) do
- begin
- FileInfo := Iter.Next;
- CurPath := FileInfo.Name;
- if CurPath.IsDirectory() then
- begin
- if (not CurPath.Equals('.')) and (not CurPath.Equals('..')) then
- DirectoryList.Add(RelativePath.Append(CurPath));
- end
- else
- Filelist.Add(RelativePath.Append(CurPath));
- end;
- Inc(DirectoryIsFinished);
- until (DirectoryIsFinished = DirectoryList.Count);
-
- // create missing folders
- UserPath.CreateDirectory(true); // should not be necessary since (UserPathName+'/.') is created.
- for I := 0 to DirectoryList.Count-1 do
- begin
- CurPath := DirectoryList[I] as IPath;
- DirectoryPath := UserPath.Append(CurPath);
- CreatedDirectory := DirectoryPath.CreateDirectory();
- FileAttrs := DirectoryPath.GetAttr();
- // Maybe analyse the target of the link with FpReadlink().
- // Let's assume the symlink is pointing to an existing directory.
- if (not CreatedDirectory) and (FileAttrs and faSymLink > 0) then
- Log.LogError('Failed to create the folder "'+ DirectoryPath.ToNative +'"',
- 'TPlatformMacOSX.CreateUserFolders');
- end;
-
- // copy missing files
- for I := 0 to Filelist.Count-1 do
- begin
- CurPath := Filelist[I] as IPath;
- SrcFile := BaseDir.Append(CurPath);
- TgtFile := UserPath.Append(CurPath);
- SrcFile.CopyFile(TgtFile, true);
- end;
-
- // go back to the initial folder
- FileSystem.SetCurrentDir(OldBaseDir);
-end;
-
-function TPlatformMacOSX.GetBundlePath: IPath;
-begin
- // Mac applications are packaged in folders.
- // Cutting the last two folders yields the application folder.
- Result := GetExecutionDir().GetParent().GetParent();
-end;
-
-function TPlatformMacOSX.GetApplicationSupportPath: IPath;
-const
- PathName: string = 'Library/Application Support/UltraStarDeluxe';
-begin
- Result := GetHomeDir().Append(PathName, pdAppend);
-end;
-
-function TPlatformMacOSX.GetHomeDir(): IPath;
-begin
- Result := Path(GetEnvironmentVariable('HOME'));
-end;
-
-function TPlatformMacOSX.GetLogPath: IPath;
-begin
- Result := GetApplicationSupportPath.Append('Logs');
-end;
-
-function TPlatformMacOSX.GetGameSharedPath: IPath;
-begin
- Result := GetApplicationSupportPath;
-end;
-
-function TPlatformMacOSX.GetGameUserPath: IPath;
-begin
- Result := GetApplicationSupportPath;
-end;
-
-end.
diff --git a/src/base/UPlatformWindows.pas b/src/base/UPlatformWindows.pas
deleted file mode 100644
index a0372dad..00000000
--- a/src/base/UPlatformWindows.pas
+++ /dev/null
@@ -1,128 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UPlatformWindows;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-// turn off messages for platform specific symbols
-{$WARN SYMBOL_PLATFORM OFF}
-
-uses
- Classes,
- UPlatform,
- UPath;
-
-type
- TPlatformWindows = class(TPlatform)
- private
- function GetSpecialPath(CSIDL: integer): IPath;
- public
- function TerminateIfAlreadyRunning(var WndTitle: String): Boolean; override;
-
- function GetLogPath: IPath; override;
- function GetGameSharedPath: IPath; override;
- function GetGameUserPath: IPath; override;
- end;
-
-implementation
-
-uses
- SysUtils,
- ShlObj,
- Windows,
- UConfig;
-
-//------------------------------
-//Start more than One Time Prevention
-//------------------------------
-function TPlatformWindows.TerminateIfAlreadyRunning(var WndTitle: String): Boolean;
-var
- hWnd: THandle;
- I: Integer;
-begin
- Result := false;
- hWnd:= FindWindow(nil, PChar(WndTitle));
- //Programm already started
- if (hWnd <> 0) then
- begin
- I := Messagebox(0, PChar('Another Instance of Ultrastar is already running. Continue ?'), PChar(WndTitle), MB_ICONWARNING or MB_YESNO);
- if (I = IDYes) then
- begin
- I := 1;
- repeat
- Inc(I);
- hWnd := FindWindow(nil, PChar(WndTitle + ' Instance ' + InttoStr(I)));
- until (hWnd = 0);
- WndTitle := WndTitle + ' Instance ' + InttoStr(I);
- end
- else
- Result := true;
- end;
-end;
-
-(**
- * Returns the path of a special folder.
- *
- * Some Folder IDs:
- * CSIDL_APPDATA (e.g. C:\Documents and Settings\username\Application Data)
- * CSIDL_LOCAL_APPDATA (e.g. C:\Documents and Settings\username\Local Settings\Application Data)
- * CSIDL_PROFILE (e.g. C:\Documents and Settings\username)
- * CSIDL_PERSONAL (e.g. C:\Documents and Settings\username\My Documents)
- * CSIDL_MYMUSIC (e.g. C:\Documents and Settings\username\My Documents\My Music)
- *)
-function TPlatformWindows.GetSpecialPath(CSIDL: integer): IPath;
-var
- Buffer: array [0..MAX_PATH-1] of WideChar;
-begin
- if (SHGetSpecialFolderPathW(0, @Buffer, CSIDL, false)) then
- Result := Path(Buffer)
- else
- Result := PATH_NONE;
-end;
-
-function TPlatformWindows.GetLogPath: IPath;
-begin
- Result := GetExecutionDir();
-end;
-
-function TPlatformWindows.GetGameSharedPath: IPath;
-begin
- Result := GetExecutionDir();
-end;
-
-function TPlatformWindows.GetGameUserPath: IPath;
-begin
- //Result := GetSpecialPath(CSIDL_APPDATA).Append('UltraStarDX', pdAppend);
- Result := GetExecutionDir();
-end;
-
-end.
diff --git a/src/base/UPlaylist.pas b/src/base/UPlaylist.pas
deleted file mode 100644
index 527eca7b..00000000
--- a/src/base/UPlaylist.pas
+++ /dev/null
@@ -1,520 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UPlaylist;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- Classes,
- USong,
- UPath,
- UPathUtils;
-
-type
- TPlaylistItem = record
- Artist: UTF8String;
- Title: UTF8String;
- SongID: Integer;
- end;
-
- APlaylistItem = array of TPlaylistItem;
-
- TPlaylist = record
- Name: UTF8String;
- Filename: IPath;
- Items: APlaylistItem;
- end;
-
- APlaylist = array of TPlaylist;
-
- //----------
- //TPlaylistManager - Class for Managing Playlists (Loading, Displaying, Saving)
- //----------
- TPlaylistManager = class
- private
-
- public
- Mode: TSingMode; //Current Playlist Mode for SongScreen
- CurPlayList: Cardinal;
- CurItem: Cardinal;
-
- Playlists: APlaylist;
-
- constructor Create;
- procedure LoadPlayLists;
- function LoadPlayList(Index: Cardinal; const Filename: IPath): Boolean;
- procedure SavePlayList(Index: Cardinal);
-
- procedure SetPlayList(Index: Cardinal);
-
- function AddPlaylist(const Name: UTF8String): Cardinal;
- procedure DelPlaylist(const Index: Cardinal);
-
- procedure AddItem(const SongID: Cardinal; const iPlaylist: Integer = -1);
- procedure DelItem(const iItem: Cardinal; const iPlaylist: Integer = -1);
-
- procedure GetNames(var PLNames: array of UTF8String);
- function GetIndexbySongID(const SongID: Cardinal; const iPlaylist: Integer = -1): Integer;
- end;
-
- {Modes:
- 0: Standard Mode
- 1: Category Mode
- 2: PlayList Mode}
-
- var
- PlayListMan: TPlaylistManager;
-
-
-implementation
-
-uses
- SysUtils,
- USongs,
- ULog,
- UMain,
- UFilesystem,
- UGraphic,
- UThemes,
- UUnicodeUtils;
-
-//----------
-//Create - Construct Class - Dummy for now
-//----------
-constructor TPlayListManager.Create;
-begin
- inherited;
- LoadPlayLists;
-end;
-
-//----------
-//LoadPlayLists - Load list of Playlists from PlayList Folder
-//----------
-Procedure TPlayListManager.LoadPlayLists;
-var
- Len: Integer;
- PlayListBuffer: TPlayList;
- Iter: IFileIterator;
- FileInfo: TFileInfo;
-begin
- SetLength(Playlists, 0);
-
- Iter := FileSystem.FileFind(PlayListPath.Append('*.upl'), 0);
- while (Iter.HasNext) do
- begin
- Len := Length(Playlists);
- SetLength(Playlists, Len + 1);
-
- FileInfo := Iter.Next;
-
- if not LoadPlayList(Len, FileInfo.Name) then
- SetLength(Playlists, Len)
- else
- begin
- // Sort the Playlists - Insertion Sort
- PlayListBuffer := Playlists[Len];
- Dec(Len);
- while (Len >= 0) AND (CompareText(Playlists[Len].Name, PlayListBuffer.Name) >= 0) do
- begin
- Playlists[Len+1] := Playlists[Len];
- Dec(Len);
- end;
- Playlists[Len+1] := PlayListBuffer;
- end;
- end;
-end;
-
-//----------
-//LoadPlayList - Load a Playlist in the Array
-//----------
-function TPlayListManager.LoadPlayList(Index: Cardinal; const Filename: IPath): Boolean;
-
- function FindSong(Artist, Title: UTF8String): Integer;
- var I: Integer;
- begin
- Result := -1;
-
- For I := low(CatSongs.Song) to high(CatSongs.Song) do
- begin
- if (CatSongs.Song[I].Title = Title) and (CatSongs.Song[I].Artist = Artist) then
- begin
- Result := I;
- Break;
- end;
- end;
- end;
-
-var
- TextStream: TTextFileStream;
- Line: UTF8String;
- PosDelimiter: Integer;
- SongID: Integer;
- Len: Integer;
- FilenameAbs: IPath;
-begin
- //Load File
- try
- FilenameAbs := PlaylistPath.Append(Filename);
- TextStream := TMemTextFileStream.Create(FilenameAbs, fmOpenRead);
- except
- begin
- Log.LogError('Could not load Playlist: ' + FilenameAbs.ToNative);
- Result := False;
- Exit;
- end;
- end;
- Result := True;
-
- //Set Filename
- Playlists[Index].Filename := Filename;
- Playlists[Index].Name := '';
-
- //Read Until End of File
- while TextStream.ReadLine(Line) do
- begin
- if (Length(Line) > 0) then
- begin
- PosDelimiter := UTF8Pos(':', Line);
- if (PosDelimiter <> 0) then
- begin
- //Comment or Name String
- if (Line[1] = '#') then
- begin
- //Found Name Value
- if (Uppercase(Trim(copy(Line, 2, PosDelimiter - 2))) = 'NAME') then
- PlayLists[Index].Name := Trim(copy(Line, PosDelimiter + 1,Length(Line) - PosDelimiter))
-
- end
- //Song Entry
- else
- begin
- SongID := FindSong(Trim(copy(Line, 1, PosDelimiter - 1)), Trim(copy(Line, PosDelimiter + 1, Length(Line) - PosDelimiter)));
- if (SongID <> -1) then
- begin
- Len := Length(PlayLists[Index].Items);
- SetLength(PlayLists[Index].Items, Len + 1);
-
- PlayLists[Index].Items[Len].SongID := SongID;
-
- PlayLists[Index].Items[Len].Artist := Trim(copy(Line, 1, PosDelimiter - 1));
- PlayLists[Index].Items[Len].Title := Trim(copy(Line, PosDelimiter + 1, Length(Line) - PosDelimiter));
- end
- else Log.LogError('Could not find Song in Playlist: ' + PlayLists[Index].Filename.ToNative + ', ' + Line);
- end;
- end;
- end;
- end;
-
- //If no special name is given, use Filename
- if PlayLists[Index].Name = '' then
- begin
- PlayLists[Index].Name := FileName.SetExtension('').ToUTF8;
- end;
-
- //Finish (Close File)
- TextStream.Free;
-end;
-
-{**
- * Saves the specified Playlist
- *}
-procedure TPlayListManager.SavePlayList(Index: Cardinal);
-var
- TextStream: TTextFileStream;
- PlaylistFile: IPath;
- I: Integer;
-begin
- PlaylistFile := PlaylistPath.Append(Playlists[Index].Filename);
-
- // cannot update read-only file
- if PlaylistFile.IsFile() and PlaylistFile.IsReadOnly() then
- Exit;
-
- // open file for rewriting
- TextStream := TMemTextFileStream.Create(PlaylistFile, fmCreate);
- try
- // Write version (not nessecary but helpful)
- TextStream.WriteLine('######################################');
- TextStream.WriteLine('#Ultrastar Deluxe Playlist Format v1.0');
- TextStream.WriteLine(Format('#Playlist %s with %d Songs.',
- [ Playlists[Index].Name, Length(Playlists[Index].Items) ]));
- TextStream.WriteLine('######################################');
-
- // Write name information
- TextStream.WriteLine('#Name: ' + Playlists[Index].Name);
-
- // Write song information
- TextStream.WriteLine('#Songs:');
-
- for I := 0 to high(Playlists[Index].Items) do
- begin
- TextStream.WriteLine(Playlists[Index].Items[I].Artist + ' : ' + Playlists[Index].Items[I].Title);
- end;
- except
- Log.LogError('Could not write Playlistfile "' + Playlists[Index].Name + '"');
- end;
- TextStream.Free;
-end;
-
-{**
- * Display a Playlist in CatSongs
- *}
-procedure TPlayListManager.SetPlayList(Index: Cardinal);
-var
- I: Integer;
-begin
- if (Int(Index) > High(PlayLists)) then
- exit;
-
- //Hide all Songs
- for I := 0 to high(CatSongs.Song) do
- CatSongs.Song[I].Visible := False;
-
- //Show Songs in PL
- for I := 0 to high(PlayLists[Index].Items) do
- begin
- CatSongs.Song[PlayLists[Index].Items[I].SongID].Visible := True;
- end;
-
- //Set CatSongsMode + Playlist Mode
- CatSongs.CatNumShow := -3;
- Mode := smPlayListRandom;
-
- //Set CurPlaylist
- CurPlaylist := Index;
-
- //Show Cat in Topleft:
- ScreenSong.ShowCatTLCustom(Format(Theme.Playlist.CatText,[Playlists[Index].Name]));
-
- //Fix SongSelection
- ScreenSong.Interaction := 0;
- ScreenSong.SelectNext(true);
- ScreenSong.FixSelected;
-
- //Play correct Music
- ScreenSong.ChangeMusic;
-end;
-
-//----------
-//AddPlaylist - Adds a Playlist and Returns the Index
-//----------
-function TPlayListManager.AddPlaylist(const Name: UTF8String): cardinal;
-var
- I: Integer;
- PlaylistFile: IPath;
-begin
- Result := Length(Playlists);
- SetLength(Playlists, Result + 1);
-
- // Sort the Playlists - Insertion Sort
- while (Result > 0) and (CompareText(Playlists[Result - 1].Name, Name) >= 0) do
- begin
- Dec(Result);
- Playlists[Result+1] := Playlists[Result];
- end;
- Playlists[Result].Name := Name;
-
- // clear playlist items
- SetLength(Playlists[Result].Items, 0);
-
- I := 1;
- PlaylistFile := PlaylistPath.Append(Name + '.upl');
- while (PlaylistFile.Exists) do
- begin
- Inc(I);
- PlaylistFile := PlaylistPath.Append(Name + InttoStr(I) + '.upl');
- end;
- Playlists[Result].Filename := PlaylistFile.GetName;
-
- //Save new Playlist
- SavePlayList(Result);
-end;
-
-//----------
-//DelPlaylist - Deletes a Playlist
-//----------
-procedure TPlayListManager.DelPlaylist(const Index: Cardinal);
-var
- I: Integer;
- Filename: IPath;
-begin
- if Int(Index) > High(Playlists) then
- Exit;
-
- Filename := PlaylistPath.Append(Playlists[Index].Filename);
-
- //If not FileExists or File is not Writeable then exit
- if (not Filename.IsFile()) or (Filename.IsReadOnly()) then
- Exit;
-
-
- //Delete Playlist from FileSystem
- if not Filename.DeleteFile() then
- Exit;
-
- //Delete Playlist from Array
- //move all PLs to the Hole
- for I := Index to High(Playlists)-1 do
- PlayLists[I] := PlayLists[I+1];
-
- //Delete last Playlist
- SetLength (Playlists, High(Playlists));
-
- //If Playlist is Displayed atm
- //-> Display Songs
- if (CatSongs.CatNumShow = -3) and (Index = CurPlaylist) then
- begin
- ScreenSong.UnLoadDetailedCover;
- ScreenSong.HideCatTL;
- CatSongs.SetFilter('', fltAll);
- ScreenSong.Interaction := 0;
- ScreenSong.FixSelected;
- ScreenSong.ChangeMusic;
- end;
-end;
-
-//----------
-//AddItem - Adds an Item to a specific Playlist
-//----------
-Procedure TPlayListManager.AddItem(const SongID: Cardinal; const iPlaylist: Integer);
-var
- P: Cardinal;
- Len: Cardinal;
-begin
- if iPlaylist = -1 then
- P := CurPlaylist
- else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then
- P := iPlaylist
- else
- exit;
-
- if (Int(SongID) <= High(CatSongs.Song)) AND (NOT CatSongs.Song[SongID].Main) then
- begin
- Len := Length(Playlists[P].Items);
- SetLength(Playlists[P].Items, Len + 1);
-
- Playlists[P].Items[Len].SongID := SongID;
- Playlists[P].Items[Len].Title := CatSongs.Song[SongID].Title;
- Playlists[P].Items[Len].Artist := CatSongs.Song[SongID].Artist;
-
- //Save Changes
- SavePlayList(P);
-
- //Correct Display when Editing current Playlist
- if (CatSongs.CatNumShow = -3) and (P = CurPlaylist) then
- SetPlaylist(P);
- end;
-end;
-
-//----------
-//DelItem - Deletes an Item from a specific Playlist
-//----------
-Procedure TPlayListManager.DelItem(const iItem: Cardinal; const iPlaylist: Integer);
-var
- I: Integer;
- P: Cardinal;
-begin
- if iPlaylist = -1 then
- P := CurPlaylist
- else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then
- P := iPlaylist
- else
- exit;
-
- if (Int(iItem) <= high(Playlists[P].Items)) then
- begin
- //Move all entrys behind deleted one to Front
- For I := iItem to High(Playlists[P].Items) - 1 do
- Playlists[P].Items[I] := Playlists[P].Items[I + 1];
-
- //Delete Last Entry
- SetLength(PlayLists[P].Items, Length(PlayLists[P].Items) - 1);
-
- //Save Changes
- SavePlayList(P);
- end;
-
- //Delete Playlist if Last Song is deleted
- if (Length(PlayLists[P].Items) = 0) then
- begin
- DelPlaylist(P);
- end
- //Correct Display when Editing current Playlist
- else if (CatSongs.CatNumShow = -3) and (P = CurPlaylist) then
- SetPlaylist(P);
-end;
-
-//----------
-//GetNames - Writes Playlist Names in a Array
-//----------
-procedure TPlayListManager.GetNames(var PLNames: array of UTF8String);
-var
- I: Integer;
- Len: Integer;
-begin
- Len := High(Playlists);
-
- if (Length(PLNames) <> Len + 1) then
- exit;
-
- For I := 0 to Len do
- PLNames[I] := Playlists[I].Name;
-end;
-
-//----------
-//GetIndexbySongID - Returns Index in the specified Playlist of the given Song
-//----------
-Function TPlayListManager.GetIndexbySongID(const SongID: Cardinal; const iPlaylist: Integer): Integer;
-var
- P: Integer;
- I: Integer;
-begin
- Result := -1;
-
- if iPlaylist = -1 then
- P := CurPlaylist
- else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then
- P := iPlaylist
- else
- exit;
-
- For I := 0 to high(Playlists[P].Items) do
- begin
- if (Playlists[P].Items[I].SongID = Int(SongID)) then
- begin
- Result := I;
- Break;
- end;
- end;
-end;
-
-end.
diff --git a/src/base/URecord.pas b/src/base/URecord.pas
deleted file mode 100644
index 2c2093a0..00000000
--- a/src/base/URecord.pas
+++ /dev/null
@@ -1,777 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit URecord;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- Classes,
- Math,
- sdl,
- SysUtils,
- UCommon,
- UMusic,
- UIni;
-
-const
- BaseToneFreq = 65.4064; // lowest (half-)tone to analyze (C2 = 65.4064 Hz)
- NumHalftones = 36; // C2-B4 (for Whitney and my high voice)
-
-type
- TCaptureBuffer = class
- private
- VoiceStream: TAudioVoiceStream; // stream for voice passthrough
- AnalysisBufferLock: PSDL_Mutex;
-
- function GetToneString: string; // converts a tone to its string represenatation;
-
- procedure BoostBuffer(Buffer: PByteArray; Size: integer);
- procedure ProcessNewBuffer(Buffer: PByteArray; BufferSize: integer);
-
- // we call it to analyze sound by checking Autocorrelation
- procedure AnalyzeByAutocorrelation;
- // use this to check one frequency by Autocorrelation
- function AnalyzeAutocorrelationFreq(Freq: real): real;
- public
- AnalysisBuffer: array[0..4095] of smallint; // newest 4096 samples
- AnalysisBufferSize: integer; // number of samples of BufferArray to analyze
-
- LogBuffer: TMemoryStream; // full buffer
-
- AudioFormat: TAudioFormatInfo;
-
- // pitch detection
- // TODO: remove ToneValid, set Tone/ToneAbs=-1 if invalid instead
- ToneValid: boolean; // true if Tone contains a valid value (otherwise it contains noise)
- Tone: integer; // tone relative to one octave (e.g. C2=C3=C4). Range: 0-11
- ToneAbs: integer; // absolute (full range) tone (e.g. C2<>C3). Range: 0..NumHalftones-1
-
- // methods
- constructor Create;
- destructor Destroy; override;
-
- procedure Clear;
-
- // use to analyze sound from buffers to get new pitch
- procedure AnalyzeBuffer;
- procedure LockAnalysisBuffer(); {$IFDEF HasInline}inline;{$ENDIF}
- procedure UnlockAnalysisBuffer(); {$IFDEF HasInline}inline;{$ENDIF}
-
- function MaxSampleVolume: single;
- property ToneString: string READ GetToneString;
- end;
-
-const
- DEFAULT_SOURCE_NAME = '[Default]';
-
-type
- TAudioInputSource = record
- Name: string;
- end;
-
- // soundcard input-devices information
- TAudioInputDevice = class
- public
- CfgIndex: integer; // index of this device in Ini.InputDeviceConfig
- Name: string; // soundcard name
- Source: array of TAudioInputSource; // soundcard input-sources
- SourceRestore: integer; // source-index that will be selected after capturing (-1: not detected)
- MicSource: integer; // source-index of mic (-1: none detected)
-
- AudioFormat: TAudioFormatInfo; // capture format info (e.g. 44.1kHz SInt16 stereo)
- CaptureChannel: array of TCaptureBuffer; // sound-buffer references used for mono or stereo channel's capture data
-
- destructor Destroy; override;
-
- procedure LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer);
-
- // TODO: add Open/Close functions so Start/Stop becomes faster
- //function Open(): boolean; virtual; abstract;
- //function Close(): boolean; virtual; abstract;
- function Start(): boolean; virtual; abstract;
- function Stop(): boolean; virtual; abstract;
-
- function GetVolume(): single; virtual; abstract;
- procedure SetVolume(Volume: single); virtual; abstract;
- end;
-
- TAudioInputProcessor = class
- public
- Sound: array of TCaptureBuffer; // sound-buffers for every player
- DeviceList: array of TAudioInputDevice;
-
- constructor Create;
- destructor Destroy; override;
-
- procedure UpdateInputDeviceConfig;
-
- // handle microphone input
- procedure HandleMicrophoneData(Buffer: PByteArray; Size: integer;
- InputDevice: TAudioInputDevice);
- end;
-
- TAudioInputBase = class( TInterfacedObject, IAudioInput )
- private
- Started: boolean;
- protected
- function UnifyDeviceName(const name: string; deviceIndex: integer): string;
- public
- function GetName: String; virtual; abstract;
- function InitializeRecord: boolean; virtual; abstract;
- function FinalizeRecord: boolean; virtual;
-
- procedure CaptureStart;
- procedure CaptureStop;
- end;
-
- TSmallIntArray = array [0..(MaxInt div SizeOf(SmallInt))-1] of SmallInt;
- PSmallIntArray = ^TSmallIntArray;
-
- function AudioInputProcessor(): TAudioInputProcessor;
-
-implementation
-
-uses
- ULog,
- UNote;
-
-var
- singleton_AudioInputProcessor : TAudioInputProcessor = nil;
-
-{ Global }
-
-function AudioInputProcessor(): TAudioInputProcessor;
-begin
- if singleton_AudioInputProcessor = nil then
- singleton_AudioInputProcessor := TAudioInputProcessor.create();
-
- result := singleton_AudioInputProcessor;
-end;
-
-{ TAudioInputDevice }
-
-destructor TAudioInputDevice.Destroy;
-begin
- Stop();
- Source := nil;
- CaptureChannel := nil;
- FreeAndNil(AudioFormat);
- inherited Destroy;
-end;
-
-procedure TAudioInputDevice.LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer);
-var
- DeviceCfg: PInputDeviceConfig;
- OldSound: TCaptureBuffer;
-begin
- // check bounds
- if ((ChannelIndex < 0) or (ChannelIndex > High(CaptureChannel))) then
- Exit;
-
- // reset previously assigned (old) capture-buffer
- OldSound := CaptureChannel[ChannelIndex];
- if (OldSound <> nil) then
- begin
- // close voice stream
- FreeAndNil(OldSound.VoiceStream);
- // free old audio-format info
- FreeAndNil(OldSound.AudioFormat);
- end;
-
- // set audio-format of new capture-buffer
- if (Sound <> nil) then
- begin
- // copy the input-device audio-format ...
- Sound.AudioFormat := AudioFormat.Copy;
- // and adjust it because capture buffers are always mono
- Sound.AudioFormat.Channels := 1;
- DeviceCfg := @Ini.InputDeviceConfig[CfgIndex];
-
- if (Ini.VoicePassthrough = 1) then
- begin
- // TODO: map odd players to the left and even players to the right speaker
- Sound.VoiceStream := AudioPlayback.CreateVoiceStream(CHANNELMAP_FRONT, AudioFormat);
- end;
- end;
-
- // replace old with new buffer (Note: Sound might be nil)
- CaptureChannel[ChannelIndex] := Sound;
-end;
-
-{ TSound }
-
-constructor TCaptureBuffer.Create;
-begin
- inherited;
- LogBuffer := TMemoryStream.Create;
- AnalysisBufferLock := SDL_CreateMutex();
- AnalysisBufferSize := Length(AnalysisBuffer);
-end;
-
-destructor TCaptureBuffer.Destroy;
-begin
- FreeAndNil(LogBuffer);
- FreeAndNil(VoiceStream);
- FreeAndNil(AudioFormat);
- SDL_DestroyMutex(AnalysisBufferLock);
- inherited;
-end;
-
-procedure TCaptureBuffer.LockAnalysisBuffer();
-begin
- SDL_mutexP(AnalysisBufferLock);
-end;
-
-procedure TCaptureBuffer.UnlockAnalysisBuffer();
-begin
- SDL_mutexV(AnalysisBufferLock);
-end;
-
-procedure TCaptureBuffer.Clear;
-begin
- if assigned(LogBuffer) then
- LogBuffer.Clear;
- LockAnalysisBuffer();
- FillChar(AnalysisBuffer[0], Length(AnalysisBuffer) * SizeOf(SmallInt), 0);
- UnlockAnalysisBuffer();
-end;
-
-procedure TCaptureBuffer.ProcessNewBuffer(Buffer: PByteArray; BufferSize: integer);
-var
- BufferOffset: integer;
- SampleCount: integer;
- i: integer;
-begin
- // apply software boost
- BoostBuffer(Buffer, BufferSize);
-
- // voice passthrough (send data to playback-device)
- if (assigned(VoiceStream)) then
- VoiceStream.WriteData(Buffer, BufferSize);
-
- // we assume that samples are in S16Int format
- // TODO: support float too
- if (AudioFormat.Format <> asfS16) then
- Exit;
-
- // process BufferArray
- BufferOffset := 0;
-
- SampleCount := BufferSize div SizeOf(SmallInt);
-
- // check if we have more new samples than we can store
- if (SampleCount > Length(AnalysisBuffer)) then
- begin
- // discard the oldest of the new samples
- BufferOffset := (SampleCount - Length(AnalysisBuffer)) * SizeOf(SmallInt);
- SampleCount := Length(AnalysisBuffer);
- end;
-
- LockAnalysisBuffer();
- try
-
- // move old samples to the beginning of the array (if necessary)
- for i := 0 to High(AnalysisBuffer)-SampleCount do
- AnalysisBuffer[i] := AnalysisBuffer[i+SampleCount];
-
- // copy new samples to analysis buffer
- Move(Buffer[BufferOffset], AnalysisBuffer[Length(AnalysisBuffer)-SampleCount],
- SampleCount * SizeOf(SmallInt));
-
- finally
- UnlockAnalysisBuffer();
- end;
-
- // save capture-data to BufferLong if enabled
- if (Ini.SavePlayback = 1) then
- begin
- // this is just for debugging (approx 15MB per player for a 3min song!!!)
- // For an in-game replay-mode we need to compress data so we do not
- // waste that much memory. Maybe ogg-vorbis with voice-preset in fast-mode?
- // Or we could use a faster but not that efficient lossless compression.
- LogBuffer.WriteBuffer(Buffer, BufferSize);
- end;
-end;
-
-procedure TCaptureBuffer.AnalyzeBuffer;
-var
- Volume: single;
- MaxVolume: single;
- SampleIndex: integer;
- Threshold: single;
-begin
- ToneValid := false;
- ToneAbs := -1;
- Tone := -1;
-
- LockAnalysisBuffer();
- try
-
- // find maximum volume of first 1024 samples
- MaxVolume := 0;
- for SampleIndex := 0 to 1023 do
- begin
- Volume := Abs(AnalysisBuffer[SampleIndex]) / -Low(Smallint);
- if Volume > MaxVolume then
- MaxVolume := Volume;
- end;
-
- Threshold := IThresholdVals[Ini.ThresholdIndex];
-
- // check if signal has an acceptable volume (ignore background-noise)
- if MaxVolume >= Threshold then
- begin
- // analyse the current voice pitch
- AnalyzeByAutocorrelation;
- ToneValid := true;
- end;
-
- finally
- UnlockAnalysisBuffer();
- end;
-end;
-
-procedure TCaptureBuffer.AnalyzeByAutocorrelation;
-var
- ToneIndex: integer;
- CurFreq: real;
- CurWeight: real;
- MaxWeight: real;
- MaxTone: integer;
-const
- HalftoneBase = 1.05946309436; // 2^(1/12) -> HalftoneBase^12 = 2 (one octave)
-begin
- // prepare to analyze
- MaxWeight := -1;
- MaxTone := 0; // this is not needed, but it satifies the compiler
-
- // analyze halftones
- // Note: at the lowest tone (~65Hz) and a buffer-size of 4096
- // at 44.1 (or 48kHz) only 6 (or 5) samples are compared, this might be
- // too few samples -> use a bigger buffer-size
- for ToneIndex := 0 to NumHalftones-1 do
- begin
- CurFreq := BaseToneFreq * Power(HalftoneBase, ToneIndex);
- CurWeight := AnalyzeAutocorrelationFreq(CurFreq);
-
- // TODO: prefer higher frequencies (use >= or use downto)
- if (CurWeight > MaxWeight) then
- begin
- // this frequency has a higher weight
- MaxWeight := CurWeight;
- MaxTone := ToneIndex;
- end;
- end;
-
- ToneAbs := MaxTone;
- Tone := MaxTone mod 12;
-end;
-
-// result medium difference
-function TCaptureBuffer.AnalyzeAutocorrelationFreq(Freq: real): real;
-var
- Dist: real; // distance (0=equal .. 1=totally different) between correlated samples
- AccumDist: real; // accumulated distances
- SampleIndex: integer; // index of sample to analyze
- CorrelatingSampleIndex: integer; // index of sample one period ahead
- SamplesPerPeriod: integer; // samples in one period
-begin
- SampleIndex := 0;
- SamplesPerPeriod := Round(AudioFormat.SampleRate/Freq);
- CorrelatingSampleIndex := SampleIndex + SamplesPerPeriod;
-
- AccumDist := 0;
-
- // compare correlating samples
- while (CorrelatingSampleIndex < AnalysisBufferSize) do
- begin
- // calc distance (correlation: 1-dist) to corresponding sample in next period
- Dist := Abs(AnalysisBuffer[SampleIndex] - AnalysisBuffer[CorrelatingSampleIndex]) /
- High(Word);
- AccumDist := AccumDist + Dist;
- Inc(SampleIndex);
- Inc(CorrelatingSampleIndex);
- end;
-
- // return "inverse" average distance (=correlation)
- Result := 1 - AccumDist / AnalysisBufferSize;
-end;
-
-function TCaptureBuffer.MaxSampleVolume: single;
-var
- lSampleIndex: integer;
- lMaxVol: longint;
-begin;
- LockAnalysisBuffer();
- try
- lMaxVol := 0;
- for lSampleIndex := 0 to High(AnalysisBuffer) do
- begin
- if Abs(AnalysisBuffer[lSampleIndex]) > lMaxVol then
- lMaxVol := Abs(AnalysisBuffer[lSampleIndex]);
- end;
- finally
- UnlockAnalysisBuffer();
- end;
-
- result := lMaxVol / -Low(Smallint);
-end;
-
-const
- ToneStrings: array[0..11] of string = (
- 'C', 'C#', 'D', 'D#', 'E', 'F', 'F#', 'G', 'G#', 'A', 'A#', 'B'
- );
-
-function TCaptureBuffer.GetToneString: string;
-begin
- if (ToneValid) then
- Result := ToneStrings[Tone] + IntToStr(ToneAbs div 12 + 2)
- else
- Result := '-';
-end;
-
-procedure TCaptureBuffer.BoostBuffer(Buffer: PByteArray; Size: integer);
-var
- i: integer;
- Value: longint;
- SampleCount: integer;
- SampleBuffer: PSmallIntArray; // buffer handled as array of samples
- Boost: byte;
-begin
- // TODO: set boost per device
- case Ini.MicBoost of
- 0: Boost := 1;
- 1: Boost := 2;
- 2: Boost := 4;
- 3: Boost := 8;
- else Boost := 1;
- end;
-
- // at the moment we will boost SInt16 data only
- if (AudioFormat.Format = asfS16) then
- begin
- // interpret buffer as buffer of bytes
- SampleBuffer := PSmallIntArray(Buffer);
- SampleCount := Size div AudioFormat.FrameSize;
-
- // boost buffer
- for i := 0 to SampleCount-1 do
- begin
- Value := SampleBuffer^[i] * Boost;
-
- if Value > High(Smallint) then
- Value := High(Smallint);
-
- if Value < Low(Smallint) then
- Value := Low(Smallint);
-
- SampleBuffer^[i] := Value;
- end;
- end;
-end;
-
-{ TAudioInputProcessor }
-
-constructor TAudioInputProcessor.Create;
-var
- i: integer;
-begin
- inherited;
- SetLength(Sound, 6 {max players});//Ini.Players+1);
- for i := 0 to High(Sound) do
- Sound[i] := TCaptureBuffer.Create;
-end;
-
-destructor TAudioInputProcessor.Destroy;
-var
- i: integer;
-begin
- for i := 0 to High(Sound) do
- Sound[i].Free;
- SetLength(Sound, 0);
- inherited;
-end;
-
-// updates InputDeviceConfig with current input-device information
-// See: TIni.LoadInputDeviceCfg()
-procedure TAudioInputProcessor.UpdateInputDeviceConfig;
-var
- deviceIndex: integer;
- newDevice: boolean;
- deviceIniIndex: integer;
- deviceCfg: PInputDeviceConfig;
- device: TAudioInputDevice;
- channelCount: integer;
- channelIndex: integer;
- i: integer;
-begin
- // Input devices - append detected soundcards
- for deviceIndex := 0 to High(DeviceList) do
- begin
- newDevice := true;
- //Search for Card in List
- for deviceIniIndex := 0 to High(Ini.InputDeviceConfig) do
- begin
- deviceCfg := @Ini.InputDeviceConfig[deviceIniIndex];
- device := DeviceList[deviceIndex];
-
- if (deviceCfg.Name = Trim(device.Name)) then
- begin
- newDevice := false;
-
- // store highest channel index as an offset for the new channels
- channelIndex := High(deviceCfg.ChannelToPlayerMap);
- // add missing channels or remove non-existing ones
- SetLength(deviceCfg.ChannelToPlayerMap, device.AudioFormat.Channels);
- // initialize added channels to 0
- for i := channelIndex+1 to High(deviceCfg.ChannelToPlayerMap) do
- begin
- deviceCfg.ChannelToPlayerMap[i] := 0;
- end;
-
- // associate ini-index with device
- device.CfgIndex := deviceIniIndex;
- break;
- end;
- end;
-
- //If not in List -> Add
- if newDevice then
- begin
- // resize list
- SetLength(Ini.InputDeviceConfig, Length(Ini.InputDeviceConfig)+1);
- deviceCfg := @Ini.InputDeviceConfig[High(Ini.InputDeviceConfig)];
- device := DeviceList[deviceIndex];
-
- // associate ini-index with device
- device.CfgIndex := High(Ini.InputDeviceConfig);
-
- deviceCfg.Name := Trim(device.Name);
- deviceCfg.Input := 0;
-
- channelCount := device.AudioFormat.Channels;
- SetLength(deviceCfg.ChannelToPlayerMap, channelCount);
-
- for channelIndex := 0 to channelCount-1 do
- begin
- // set default at first start of USDX (1st device, 1st channel -> player1)
- if ((channelIndex = 0) and (device.CfgIndex = 0)) then
- deviceCfg.ChannelToPlayerMap[0] := 1
- else
- deviceCfg.ChannelToPlayerMap[channelIndex] := 0;
- end;
- end;
- end;
-end;
-
-{*
- * Handles captured microphone input data.
- * Params:
- * Buffer - buffer of signed 16bit interleaved stereo PCM-samples.
- * Interleaved means that a right-channel sample follows a left-
- * channel sample and vice versa (0:left[0],1:right[0],2:left[1],...).
- * Length - number of bytes in Buffer
- * Input - Soundcard-Input used for capture
- *}
-procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: PByteArray; Size: integer; InputDevice: TAudioInputDevice);
-var
- MultiChannelBuffer: PByteArray; // buffer handled as array of bytes (offset relative to channel)
- SingleChannelBuffer: PByteArray; // temporary buffer for new samples per channel
- SingleChannelBufferSize: integer;
- ChannelIndex: integer;
- CaptureChannel: TCaptureBuffer;
- AudioFormat: TAudioFormatInfo;
- SampleSize: integer;
- SamplesPerChannel: integer;
- i: integer;
-begin
- AudioFormat := InputDevice.AudioFormat;
- SampleSize := AudioSampleSize[AudioFormat.Format];
- SamplesPerChannel := Size div AudioFormat.FrameSize;
-
- SingleChannelBufferSize := SamplesPerChannel * SampleSize;
- GetMem(SingleChannelBuffer, SingleChannelBufferSize);
-
- // process channels
- for ChannelIndex := 0 to High(InputDevice.CaptureChannel) do
- begin
- CaptureChannel := InputDevice.CaptureChannel[ChannelIndex];
- // check if a capture buffer was assigned, otherwise there is nothing to do
- if (CaptureChannel <> nil) then
- begin
- // set offset according to channel index
- MultiChannelBuffer := @Buffer[ChannelIndex * SampleSize];
- // separate channel-data from interleaved multi-channel (e.g. stereo) data
- for i := 0 to SamplesPerChannel-1 do
- begin
- Move(MultiChannelBuffer[i*AudioFormat.FrameSize],
- SingleChannelBuffer[i*SampleSize],
- SampleSize);
- end;
- CaptureChannel.ProcessNewBuffer(SingleChannelBuffer, SingleChannelBufferSize);
- end;
- end;
-
- FreeMem(SingleChannelBuffer);
-end;
-
-{ TAudioInputBase }
-
-function TAudioInputBase.FinalizeRecord: boolean;
-var
- i: integer;
-begin
- for i := 0 to High(AudioInputProcessor.DeviceList) do
- AudioInputProcessor.DeviceList[i].Free();
- AudioInputProcessor.DeviceList := nil;
- Result := true;
-end;
-
-{*
- * Start capturing on all used input-device.
- *}
-procedure TAudioInputBase.CaptureStart;
-var
- S: integer;
- DeviceIndex: integer;
- ChannelIndex: integer;
- Device: TAudioInputDevice;
- DeviceCfg: PInputDeviceConfig;
- DeviceUsed: boolean;
- Player: integer;
-begin
- if (Started) then
- CaptureStop();
-
- // reset buffers
- for S := 0 to High(AudioInputProcessor.Sound) do
- AudioInputProcessor.Sound[S].Clear;
-
- // start capturing on each used device
- for DeviceIndex := 0 to High(AudioInputProcessor.DeviceList) do
- begin
- Device := AudioInputProcessor.DeviceList[DeviceIndex];
- if not assigned(Device) then
- continue;
- DeviceCfg := @Ini.InputDeviceConfig[Device.CfgIndex];
-
- DeviceUsed := false;
-
- // check if device is used
- for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do
- begin
- Player := DeviceCfg.ChannelToPlayerMap[ChannelIndex]-1;
- if (Player < 0) or (Player >= PlayersPlay) then
- begin
- Device.LinkCaptureBuffer(ChannelIndex, nil);
- end
- else
- begin
- Device.LinkCaptureBuffer(ChannelIndex, AudioInputProcessor.Sound[Player]);
- DeviceUsed := true;
- end;
- end;
-
- // start device if used
- if (DeviceUsed) then
- begin
- //Log.BenchmarkStart(2);
- Device.Start();
- //Log.BenchmarkEnd(2);
- //Log.LogBenchmark('Device.Start', 2) ;
- end;
- end;
-
- Started := true;
-end;
-
-{*
- * Stop input-capturing on all soundcards.
- *}
-procedure TAudioInputBase.CaptureStop;
-var
- DeviceIndex: integer;
- ChannelIndex: integer;
- Device: TAudioInputDevice;
- DeviceCfg: PInputDeviceConfig;
-begin
- for DeviceIndex := 0 to High(AudioInputProcessor.DeviceList) do
- begin
- Device := AudioInputProcessor.DeviceList[DeviceIndex];
- if not assigned(Device) then
- continue;
-
- Device.Stop();
-
- // disconnect capture buffers
- DeviceCfg := @Ini.InputDeviceConfig[Device.CfgIndex];
- for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do
- Device.LinkCaptureBuffer(ChannelIndex, nil);
- end;
-
- Started := false;
-end;
-
-function TAudioInputBase.UnifyDeviceName(const name: string; deviceIndex: integer): string;
-var
- count: integer; // count of devices with this name
-
- function IsDuplicate(const name: string): boolean;
- var
- i: integer;
- begin
- Result := false;
- // search devices with same description
- for i := 0 to deviceIndex-1 do
- begin
- if (AudioInputProcessor.DeviceList[i].Name = name) then
- begin
- Result := true;
- Break;
- end;
- end;
- end;
-
-begin
- count := 1;
- result := name;
-
- // if there is another device with the same ID, search for an available name
- while (IsDuplicate(result)) do
- begin
- Inc(count);
- // set description
- result := name + ' ('+IntToStr(count)+')';
- end;
-end;
-
-end.
diff --git a/src/base/USingScores.pas b/src/base/USingScores.pas
deleted file mode 100644
index f280900e..00000000
--- a/src/base/USingScores.pas
+++ /dev/null
@@ -1,1122 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit USingScores;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- gl,
- UThemes,
- UTexture;
-
-//////////////////////////////////////////////////////////////
-// ATTENTION: //
-// Enabled flag does not work atm. This should cause popups //
-// not to move and scores to stay until re-enabling. //
-// To use e.g. in pause mode //
-// also invisible flag causes attributes not to change. //
-// This should be fixed after next draw when visible = true,//
-// but not tested yet //
-//////////////////////////////////////////////////////////////
-
-// some constants containing options that could change by time
-const
- MaxPlayers = 6; // maximum of players that could be added
- MaxPositions = 6; // maximum of score positions that could be added
-
-type
- //-----------
- // TScorePlayer - record containing information about a players score
- //-----------
- TScorePlayer = record
- Position: byte; // index of the position where the player should be drawn
- Enabled: boolean; // is the score display enabled
- Visible: boolean; // is the score display visible
- Score: word; // current score of the player
- ScoreDisplayed: word; // score cur. displayed (for counting up)
- ScoreBG: TTexture; // texture of the players scores bg
- Color: TRGB; // the players color
- RBPos: real; // cur. percentille of the rating bar
- RBTarget: real; // target position of rating bar
- RBVisible: boolean; // is rating bar drawn
- end;
- aScorePlayer = array [0..MaxPlayers-1] of TScorePlayer;
-
- //-----------
- // TScorePosition - record containing information about a score position, that can be used
- //-----------
- PScorePosition = ^TScorePosition;
- TScorePosition = record
- // the position is used for which playercount
- PlayerCount: byte;
- // 1 - 1 player per screen
- // 2 - 2 players per screen
- // 4 - 3 players per screen
- // 6 would be 2 and 3 players per screen
-
- BGX: real; // x position of the score bg
- BGY: real; // y position of the score bg
- BGW: real; // width of the score bg
- BGH: real; // height of the score bg
-
- RBX: real; // x position of the rating bar
- RBY: real; // y position of the rating bar
- RBW: real; // width of the rating bar
- RBH: real; // height of the rating bar
-
- TextX: real; // x position of the score text
- TextY: real; // y position of the score text
- TextFont: byte; // font of the score text
- TextSize: integer; // size of the score text
-
- PUW: real; // width of the line bonus popup
- PUH: real; // height of the line bonus popup
- PUFont: byte; // font for the popups
- PUFontSize: integer; // font size for the popups
- PUStartX: real; // x start position of the line bonus popup
- PUStartY: real; // y start position of the line bonus popup
- PUTargetX: real; // x target position of the line bonus popup
- PUTargetY: real; // y target position of the line bonus popup
- end;
- aScorePosition = array [0..MaxPositions-1] of TScorePosition;
-
- //-----------
- // TScorePopUp - record containing information about a line bonus popup
- // list, next item is saved in next attribute
- //-----------
- PScorePopUp = ^TScorePopUp;
- TScorePopUp = record
- Player: byte; // index of the popups player
- TimeStamp: cardinal; // timestamp of popups spawn
- Rating: integer; // 0 to 8, type of rating (cool, bad, etc.)
- ScoreGiven: integer; // score that has already been given to the player
- ScoreDiff: integer; // difference between cur score at spawn and old score
- Next: PScorePopUp; // next item in list
- end;
- aScorePopUp = array of TScorePopUp;
-
- //-----------
- // TSingScores - class containing scores positions and drawing scores, rating bar + popups
- //-----------
- TSingScores = class
- private
- Positions: aScorePosition;
- aPlayers: aScorePlayer;
- oPositionCount: byte;
- oPlayerCount: byte;
-
- // saves the first and last popup of the list
- FirstPopUp: PScorePopUp;
- LastPopUp: PScorePopUp;
-
- // only defined during draw, time passed between
- // current and previous call of draw
- TimePassed: Cardinal;
-
- // draws a popup by pointer
- procedure DrawPopUp(const PopUp: PScorePopUp);
-
- // raises players score if RaiseScore was called
- // has to be called after DrawPopUp and before
- // DrawScore
- procedure DoRaiseScore(const Index: integer);
-
- // draws a score by playerindex
- procedure DrawScore(const Index: integer);
-
- // draws the rating bar by playerindex
- procedure DrawRatingBar(const Index: integer);
-
- // removes a popup w/o destroying the list
- procedure KillPopUp(const last, cur: PScorePopUp);
-
- // calculate the amount of points for a player that is
- // still in popups and therfore not displayed
- function GetPopUpPoints(const Index: integer): integer;
- public
- Settings: record // Record containing some Displaying Options
- Phase1Time: real; // time for phase 1 to complete (in msecs)
- // the plop up of the popup
- Phase2Time: real; // time for phase 2 to complete (in msecs)
- // the moving (mainly upwards) of the popup
- Phase3Time: real; // time for phase 3 to complete (in msecs)
- // the fade out and score adding
-
- PopUpTex: array [0..8] of TTexture; // textures for every popup rating
-
- RatingBar_BG_Tex: TTexture; // rating bar texs
- RatingBar_FG_Tex: TTexture;
- RatingBar_Bar_Tex: TTexture;
-
- end;
-
- Visible: boolean; // visibility of all scores
- Enabled: boolean; // scores are changed, popups are moved etc.
- RBVisible: boolean; // visibility of all rating bars
-
- // properties for reading position and playercount
- property PositionCount: byte read oPositionCount;
- property PlayerCount: byte read oPlayerCount;
- property Players: aScorePlayer read aPlayers;
-
- // constructor just sets some standard settings
- constructor Create;
-
- // adds a position to array and increases position count
- procedure AddPosition(const pPosition: PScorePosition);
-
- // adds a player to array and increases player count
- procedure AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: word = 0; const Enabled: boolean = true; const Visible: boolean = true);
-
- // change a players visibility, enable
- procedure ChangePlayerVisibility(const Index: byte; const pVisible: boolean);
- procedure ChangePlayerEnabled(const Index: byte; const pEnabled: boolean);
-
- // deletes all player information
- procedure ClearPlayers;
-
- // deletes positions and playerinformation
- procedure Clear;
-
- // loads some settings and the positions from theme
- procedure LoadfromTheme;
-
- // has to be called after positions and players have been added, before first call of draw
- // it gives every player a score position
- procedure Init;
-
- // raises the score of a specified player to the specified score
- procedure RaiseScore(Player: byte; Score: integer);
-
- // sets the score of a specified player to the specified score
- procedure SetScore(Player: byte; Score: integer);
-
- // spawns a new line bonus popup for the player
- procedure SpawnPopUp(const PlayerIndex: byte; const Rating: integer; const Score: integer);
-
- // removes all popups from mem
- procedure KillAllPopUps;
-
- // draws scores and line bonus popups
- procedure Draw;
- end;
-
-implementation
-
-uses
- SysUtils,
- Math,
- SDL,
- TextGL,
- ULog,
- UGraphic;
-
-{**
- * sets some standard settings
- *}
-constructor TSingScores.Create;
-begin
- inherited;
-
- // clear popuplist pointers
- FirstPopUp := nil;
- LastPopUp := nil;
-
- // clear variables
- Visible := true;
- Enabled := true;
- RBVisible := true;
-
- // clear position index
- oPositionCount := 0;
- oPlayerCount := 0;
-
- Settings.Phase1Time := 350; // plop it up . -> [ ]
- Settings.Phase2Time := 550; // shift it up ^[ ]^
- Settings.Phase3Time := 200; // increase score [s++]
-
- Settings.PopUpTex[0].TexNum := 0;
- Settings.PopUpTex[1].TexNum := 0;
- Settings.PopUpTex[2].TexNum := 0;
- Settings.PopUpTex[3].TexNum := 0;
- Settings.PopUpTex[4].TexNum := 0;
- Settings.PopUpTex[5].TexNum := 0;
- Settings.PopUpTex[6].TexNum := 0;
- Settings.PopUpTex[7].TexNum := 0;
- Settings.PopUpTex[8].TexNum := 0;
-
- Settings.RatingBar_BG_Tex.TexNum := 0;
- Settings.RatingBar_FG_Tex.TexNum := 0;
- Settings.RatingBar_Bar_Tex.TexNum := 0;
-end;
-
-{**
- * adds a position to array and increases position count
- *}
-procedure TSingScores.AddPosition(const pPosition: PScorePosition);
-begin
- if (PositionCount < MaxPositions) then
- begin
- Positions[PositionCount] := pPosition^;
- Inc(oPositionCount);
- end;
-end;
-
-{**
- * adds a player to array and increases player count
- *}
-procedure TSingScores.AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: word; const Enabled: boolean; const Visible: boolean);
-begin
- if (PlayerCount < MaxPlayers) then
- begin
- aPlayers[PlayerCount].Position := High(byte);
- aPlayers[PlayerCount].Enabled := Enabled;
- aPlayers[PlayerCount].Visible := Visible;
- aPlayers[PlayerCount].Score := Score;
- aPlayers[PlayerCount].ScoreDisplayed := Score;
- aPlayers[PlayerCount].ScoreBG := ScoreBG;
- aPlayers[PlayerCount].Color := Color;
- aPlayers[PlayerCount].RBPos := 0.5;
- aPlayers[PlayerCount].RBTarget := 0.5;
- aPlayers[PlayerCount].RBVisible := true;
-
- Inc(oPlayerCount);
- end;
-end;
-
-{**
- * change a players visibility
- *}
-procedure TSingScores.ChangePlayerVisibility(const Index: byte; const pVisible: boolean);
-begin
- if (Index < MaxPlayers) then
- aPlayers[Index].Visible := pVisible;
-end;
-
-{**
- * change player enabled
- *}
-procedure TSingScores.ChangePlayerEnabled(const Index: byte; const pEnabled: boolean);
-begin
- if (Index < MaxPlayers) then
- aPlayers[Index].Enabled := pEnabled;
-end;
-
-{**
- * procedure deletes all player information
- *}
-procedure TSingScores.ClearPlayers;
-begin
- KillAllPopUps;
- oPlayerCount := 0;
- TimePassed := 0;
-end;
-
-{**
- * procedure deletes positions and playerinformation
- *}
-procedure TSingScores.Clear;
-begin
- KillAllPopUps;
- oPlayerCount := 0;
- oPositionCount := 0;
- TimePassed := 0;
-end;
-
-{**
- * procedure loads some settings and the positions from theme
- *}
-procedure TSingScores.LoadfromTheme;
-var
- I: integer;
- procedure AddbyStatics(const PC: byte; const ScoreStatic, SingBarStatic: TThemeStatic; ScoreText: TThemeText);
- var
- nPosition: TScorePosition;
- begin
- nPosition.PlayerCount := PC; // only for one player playing
-
- nPosition.BGX := ScoreStatic.X;
- nPosition.BGY := ScoreStatic.Y;
- nPosition.BGW := ScoreStatic.W;
- nPosition.BGH := ScoreStatic.H;
-
- nPosition.TextX := ScoreText.X;
- nPosition.TextY := ScoreText.Y;
- nPosition.TextFont := ScoreText.Font;
- nPosition.TextSize := ScoreText.Size;
-
- nPosition.RBX := SingBarStatic.X;
- nPosition.RBY := SingBarStatic.Y;
- nPosition.RBW := SingBarStatic.W;
- nPosition.RBH := SingBarStatic.H;
-
- nPosition.PUW := nPosition.BGW;
- nPosition.PUH := nPosition.BGH;
-
- nPosition.PUFont := 2;
- nPosition.PUFontSize := 18;
-
- nPosition.PUStartX := nPosition.BGX;
- nPosition.PUStartY := nPosition.TextY + 65;
-
- nPosition.PUTargetX := nPosition.BGX;
- nPosition.PUTargetY := nPosition.TextY;
-
- AddPosition(@nPosition);
- end;
-begin
- Clear;
-
- // set textures
- // popup tex
- for I := 0 to 8 do
- Settings.PopUpTex[I] := Tex_SingLineBonusBack[I];
-
- // rating bar tex
- Settings.RatingBar_BG_Tex := Tex_SingBar_Back;
- Settings.RatingBar_FG_Tex := Tex_SingBar_Front;
- Settings.RatingBar_Bar_Tex := Tex_SingBar_Bar;
-
- // load positions from theme
-
- // player 1:
- AddByStatics(1, Theme.Sing.StaticP1ScoreBG, Theme.Sing.StaticP1SingBar, Theme.Sing.TextP1Score);
- AddByStatics(2, Theme.Sing.StaticP1TwoPScoreBG, Theme.Sing.StaticP1TwoPSingBar, Theme.Sing.TextP1TwoPScore);
- AddByStatics(4, Theme.Sing.StaticP1ThreePScoreBG, Theme.Sing.StaticP1ThreePSingBar, Theme.Sing.TextP1ThreePScore);
-
- // player 2:
- AddByStatics(2, Theme.Sing.StaticP2RScoreBG, Theme.Sing.StaticP2RSingBar, Theme.Sing.TextP2RScore);
- AddByStatics(4, Theme.Sing.StaticP2MScoreBG, Theme.Sing.StaticP2MSingBar, Theme.Sing.TextP2MScore);
-
- // player 3:
- AddByStatics(4, Theme.Sing.StaticP3RScoreBG, Theme.Sing.StaticP3SingBar, Theme.Sing.TextP3RScore);
-end;
-
-{**
- * raises the score of a specified player to the specified score
- *}
-procedure TSingScores.RaiseScore(Player: byte; Score: integer);
-begin
- if (Player <= PlayerCount - 1) then
- aPlayers[Player].Score := Score;
-end;
-
-{**
- * sets the score of a specified player to the specified score
- *}
-procedure TSingScores.SetScore(Player: byte; Score: integer);
- var
- Diff: Integer;
-begin
- if (Player <= PlayerCount - 1) then
- begin
- Diff := Score - Players[Player].Score;
- aPlayers[Player].Score := Score;
- Inc(aPlayers[Player].ScoreDisplayed, Diff);
- end;
-end;
-
-{**
- * spawns a new line bonus popup for the player
- *}
-procedure TSingScores.SpawnPopUp(const PlayerIndex: byte; const Rating: integer; const Score: integer);
-var
- Cur: PScorePopUp;
-begin
- if (PlayerIndex < PlayerCount) then
- begin
- // get memory and add data
- GetMem(Cur, SizeOf(TScorePopUp));
-
- Cur.Player := PlayerIndex;
- Cur.TimeStamp := SDL_GetTicks;
-
- // limit rating value to 0..8
- // a higher value would cause a crash when selecting the bg texture
- if (Rating > 8) then
- Cur.Rating := 8
- else if (Rating < 0) then
- Cur.Rating := 0
- else
- Cur.Rating := Rating;
-
- Cur.ScoreGiven:= 0;
- if (Players[PlayerIndex].Score < Score) then
- begin
- Cur.ScoreDiff := Score - Players[PlayerIndex].Score;
- aPlayers[PlayerIndex].Score := Score;
- end
- else
- Cur.ScoreDiff := 0;
- Cur.Next := nil;
-
- // Log.LogError('TSingScores.SpawnPopUp| Player: ' + InttoStr(PlayerIndex) + ', Score: ' + InttoStr(Score) + ', ScoreDiff: ' + InttoStr(Cur.ScoreDiff));
-
- // add it to the chain
- if (FirstPopUp = nil) then
- // the first popup in the list
- FirstPopUp := Cur
- else
- // second or earlier popup
- LastPopUp.Next := Cur;
-
- // set new popup to last popup in the list
- LastPopUp := Cur;
- end
- else
- Log.LogError('TSingScores: Try to add popup for non-existing player');
-end;
-
-{**
- * removes a popup w/o destroying the list
- *}
-procedure TSingScores.KillPopUp(const last, cur: PScorePopUp);
-begin
- // give player the last points that missing till now
- aPlayers[Cur.Player].ScoreDisplayed := aPlayers[Cur.Player].ScoreDisplayed + Cur.ScoreDiff - Cur.ScoreGiven;
-
- // change bars position
- if (Cur.ScoreDiff > 0) THEN
- begin // popup w/ scorechange -> give missing percentille
- aPlayers[Cur.Player].RBTarget := aPlayers[Cur.Player].RBTarget +
- (Cur.ScoreDiff - Cur.ScoreGiven) / Cur.ScoreDiff
- * (Cur.Rating / 20 - 0.26);
- end
- else
- begin // popup w/o scorechange -> give complete percentille
- aPlayers[Cur.Player].RBTarget := aPlayers[Cur.Player].RBTarget +
- (Cur.Rating / 20 - 0.26);
- end;
-
- if (aPlayers[Cur.Player].RBTarget > 1) then
- aPlayers[Cur.Player].RBTarget := 1
- else
- if (aPlayers[Cur.Player].RBTarget < 0) then
- aPlayers[Cur.Player].RBTarget := 0;
-
- // if this is the first popup => make next popup the first
- if (Cur = FirstPopUp) then
- FirstPopUp := Cur.Next
- // else => remove curent popup from chain
- else
- Last.Next := Cur.Next;
-
- // if this is the last popup, make popup before the last
- if (Cur = LastPopUp) then
- LastPopUp := Last;
-
- // free the memory
- FreeMem(Cur, SizeOf(TScorePopUp));
-end;
-
-{**
- * removes all popups from mem
- *}
-procedure TSingScores.KillAllPopUps;
-var
- Cur: PScorePopUp;
- Last: PScorePopUp;
-begin
- Cur := FirstPopUp;
-
- // remove all popups:
- while (Cur <> nil) do
- begin
- Last := Cur;
- Cur := Cur.Next;
- FreeMem(Last, SizeOf(TScorePopUp));
- end;
-
- FirstPopUp := nil;
- LastPopUp := nil;
-end;
-
-{**
- * calculate the amount of points for a player that is
- * still in popups and therfore not displayed
- *}
-function TSingScores.GetPopUpPoints(const Index: integer): integer;
- var
- CurPopUp: PScorePopUp;
-begin
- Result := 0;
-
- // only check points if there is a difference between actual
- // and displayed points
- if (Players[Index].Score > Players[Index].ScoreDisplayed) then
- begin
- CurPopUp := FirstPopUp;
- while (CurPopUp <> nil) do
- begin
- if (CurPopUp.Player = Index) then
- begin // add points left "in" popup to result
- Inc(Result, CurPopUp.ScoreDiff - CurPopUp.ScoreGiven);
- end;
- CurPopUp := CurPopUp.Next;
- end;
- end;
-end;
-
-{**
- * has to be called after positions and players have been added, before first call of draw
- * it gives each player a score position
- *}
-procedure TSingScores.Init;
-var
- PlC: array [0..1] of byte; // playercount first screen and second screen
- I, J: integer;
- MaxPlayersperScreen: byte;
- CurPlayer: byte;
-
- function GetPositionCountbyPlayerCount(bPlayerCount: byte): byte;
- var
- I: integer;
- begin
- Result := 0;
- bPlayerCount := 1 shl (bPlayerCount - 1);
-
- for I := 0 to PositionCount - 1 do
- begin
- if ((Positions[I].PlayerCount and bPlayerCount) <> 0) then
- Inc(Result);
- end;
- end;
-
- function GetPositionbyPlayernum(bPlayerCount, bPlayer: byte): byte;
- var
- I: integer;
- begin
- bPlayerCount := 1 shl (bPlayerCount - 1);
- Result := High(byte);
-
- for I := 0 to PositionCount - 1 do
- begin
- if ((Positions[I].PlayerCount and bPlayerCount) <> 0) then
- begin
- if (bPlayer = 0) then
- begin
- Result := I;
- Break;
- end
- else
- Dec(bPlayer);
- end;
- end;
- end;
-
-begin
- MaxPlayersPerScreen := 0;
-
- for I := 1 to 6 do
- begin
- // if there are enough positions -> write to maxplayers
- if (GetPositionCountbyPlayerCount(I) = I) then
- MaxPlayersPerScreen := I
- else
- Break;
- end;
-
- // split players to both screens or display on one screen
- if (Screens = 2) and (MaxPlayersPerScreen < PlayerCount) then
- begin
- PlC[0] := PlayerCount div 2 + PlayerCount mod 2;
- PlC[1] := PlayerCount div 2;
- end
- else
- begin
- PlC[0] := PlayerCount;
- PlC[1] := 0;
- end;
-
- // check if there are enough positions for all players
- for I := 0 to Screens - 1 do
- begin
- if (PlC[I] > MaxPlayersperScreen) then
- begin
- PlC[I] := MaxPlayersperScreen;
- Log.LogError('More Players than available Positions, TSingScores');
- end;
- end;
-
- CurPlayer := 0;
- // give every player a position
- for I := 0 to Screens - 1 do
- for J := 0 to PlC[I]-1 do
- begin
- aPlayers[CurPlayer].Position := GetPositionbyPlayernum(PlC[I], J) or (I shl 7);
- // Log.LogError('Player ' + InttoStr(CurPlayer) + ' gets Position: ' + InttoStr(aPlayers[CurPlayer].Position));
- Inc(CurPlayer);
- end;
-end;
-
-{**
- * draws scores and linebonus popups
- *}
-procedure TSingScores.Draw;
-var
- I: integer;
- CurTime: cardinal;
- CurPopUp, LastPopUp: PScorePopUp;
-begin
- CurTime := SDL_GetTicks;
- if (TimePassed <> 0) then
- TimePassed := CurTime - TimePassed;
-
- if Visible then
- begin
- // draw popups
- LastPopUp := nil;
- CurPopUp := FirstPopUp;
-
- while (CurPopUp <> nil) do
- begin
- if (CurTime - CurPopUp.TimeStamp > Settings.Phase1Time + Settings.Phase2Time + Settings.Phase3Time) then
- begin
- KillPopUp(LastPopUp, CurPopUp);
- if (LastPopUp = nil) then
- CurPopUp := FirstPopUp
- else
- CurPopUp := LastPopUp.Next;
- end
- else
- begin
- DrawPopUp(CurPopUp);
- LastPopUp := CurPopUp;
- CurPopUp := LastPopUp.Next;
- end;
- end;
-
-
- if (RBVisible) then
- // draw players w/ rating bar
- for I := 0 to PlayerCount-1 do
- begin
- DoRaiseScore(I);
- DrawScore(I);
- DrawRatingBar(I);
- end
- else
- // draw players w/o rating bar
- for I := 0 to PlayerCount-1 do
- begin
- DoRaiseScore(I);
- DrawScore(I);
- end;
-
- end; // eo visible
-
- TimePassed := CurTime;
-end;
-
-{**
- * raises players score if RaiseScore was called
- * has to be called after DrawPopUp and before
- * DrawScore
- *}
-procedure TSingScores.DoRaiseScore(const Index: integer);
- var
- S: integer;
- Diff: integer;
- const
- RaisePerSecond = 500;
-begin
- S := (Players[Index].Score - (Players[Index].ScoreDisplayed + GetPopUpPoints(Index)));
-
- if (S <> 0) then
- begin
- if (S > 0) then
- Diff := Min(Round(RoundTo((RaisePerSecond * TimePassed) / 1000, 1)), S)
- else
- Diff := Max(Round(RoundTo((RaisePerSecond * TimePassed) / 1000, 1)), S);
-
- Inc(aPlayers[Index].ScoreDisplayed, Diff);
- end;
-end;
-
-{**
- * draws a popup by pointer
- *}
-procedure TSingScores.DrawPopUp(const PopUp: PScorePopUp);
-var
- Progress: real;
- CurTime: cardinal;
- X, Y, W, H, Alpha: real;
- FontSize: integer;
- FontOffset: real;
- TimeDiff: cardinal;
- PIndex: byte;
- TextLen: real;
- ScoretoAdd: word;
- PosDiff: real;
-begin
- if (PopUp <> nil) then
- begin
- // only draw if player has a position
- PIndex := Players[PopUp.Player].Position;
- if PIndex <> High(byte) then
- begin
- // only draw if player is on cur screen
- if ((Players[PopUp.Player].Position and 128) = 0) = (ScreenAct = 1) then
- begin
- CurTime := SDL_GetTicks;
- if not (Enabled and Players[PopUp.Player].Enabled) then
- // increase timestamp with tiem where there is no movement ...
- begin
- // Inc(PopUp.TimeStamp, LastRender);
- end;
- TimeDiff := CurTime - PopUp.TimeStamp;
-
- // get position of popup
- PIndex := PIndex and 127;
-
-
- // check for phase ...
- if (TimeDiff <= Settings.Phase1Time) then
- begin
- // phase 1 - the ploping up
- Progress := TimeDiff / Settings.Phase1Time;
-
-
- W := Positions[PIndex].PUW * Sin(Progress/2*Pi);
- H := Positions[PIndex].PUH * Sin(Progress/2*Pi);
-
- X := Positions[PIndex].PUStartX + (Positions[PIndex].PUW - W)/2;
- Y := Positions[PIndex].PUStartY + (Positions[PIndex].PUH - H)/2;
-
- FontSize := Round(Progress * Positions[PIndex].PUFontSize);
- FontOffset := (H - FontSize) / 2;
- Alpha := 1;
- end
-
- else if (TimeDiff <= Settings.Phase2Time + Settings.Phase1Time) then
- begin
- // phase 2 - the moving
- Progress := (TimeDiff - Settings.Phase1Time) / Settings.Phase2Time;
-
- W := Positions[PIndex].PUW;
- H := Positions[PIndex].PUH;
-
- PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX;
- if PosDiff > 0 then
- PosDiff := PosDiff + W;
- X := Positions[PIndex].PUStartX + PosDiff * sqr(Progress);
-
- PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY;
- if PosDiff < 0 then
- PosDiff := PosDiff + Positions[PIndex].BGH;
- Y := Positions[PIndex].PUStartY + PosDiff * sqr(Progress);
-
- FontSize := Positions[PIndex].PUFontSize;
- FontOffset := (H - FontSize) / 2;
- Alpha := 1 - 0.3 * Progress;
- end
-
- else
- begin
- // phase 3 - the fading out + score adding
- Progress := (TimeDiff - Settings.Phase1Time - Settings.Phase2Time) / Settings.Phase3Time;
-
- if (PopUp.Rating > 0) then
- begin
- // add scores if player enabled
- if (Enabled and Players[PopUp.Player].Enabled) then
- begin
- ScoreToAdd := Round(PopUp.ScoreDiff * Progress) - PopUp.ScoreGiven;
- Inc(PopUp.ScoreGiven, ScoreToAdd);
- aPlayers[PopUp.Player].ScoreDisplayed := Players[PopUp.Player].ScoreDisplayed + ScoreToAdd;
-
- // change bar positions
- if PopUp.ScoreDiff = 0 then
- Log.LogError('TSingScores.DrawPopUp', 'PopUp.ScoreDiff is 0 and we want to divide by it. No idea how this happens.')
- else
- aPlayers[PopUp.Player].RBTarget := aPlayers[PopUp.Player].RBTarget + ScoreToAdd/PopUp.ScoreDiff * (PopUp.Rating / 20 - 0.26);
- if (aPlayers[PopUp.Player].RBTarget > 1) then
- aPlayers[PopUp.Player].RBTarget := 1
- else if (aPlayers[PopUp.Player].RBTarget < 0) then
- aPlayers[PopUp.Player].RBTarget := 0;
- end;
-
- // set positions etc.
- Alpha := 0.7 - 0.7 * Progress;
-
- W := Positions[PIndex].PUW;
- H := Positions[PIndex].PUH;
-
- PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX;
- if (PosDiff > 0) then
- PosDiff := W
- else
- PosDiff := 0;
- X := Positions[PIndex].PUTargetX + PosDiff * Progress;
-
- PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY;
- if (PosDiff < 0) then
- PosDiff := -Positions[PIndex].BGH
- else
- PosDiff := 0;
- Y := Positions[PIndex].PUTargetY - PosDiff * (1 - Progress);
-
- FontSize := Positions[PIndex].PUFontSize;
- FontOffset := (H - FontSize) / 2;
- end
- else
- begin
- // here the effect that should be shown if a popup without score is drawn
- // and or spawn with the graphicobjects etc.
- // some work for blindy to do :p
-
- // atm: just let it slide in the scores just like the normal popup
- Alpha := 0;
- end;
- end;
-
- // draw popup
-
- if (Alpha > 0) and (Players[PopUp.Player].Visible) then
- begin
- // draw bg:
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
-
- glColor4f(1,1,1, Alpha);
- glBindTexture(GL_TEXTURE_2D, Settings.PopUpTex[PopUp.Rating].TexNum);
-
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(X, Y);
- glTexCoord2f(0, Settings.PopUpTex[PopUp.Rating].TexH); glVertex2f(X, Y + H);
- glTexCoord2f(Settings.PopUpTex[PopUp.Rating].TexW, Settings.PopUpTex[PopUp.Rating].TexH); glVertex2f(X + W, Y + H);
- glTexCoord2f(Settings.PopUpTex[PopUp.Rating].TexW, 0); glVertex2f(X + W, Y);
- glEnd;
-
- glDisable(GL_TEXTURE_2D);
- glDisable(GL_BLEND);
-
- // set font style and size
- SetFontStyle(Positions[PIndex].PUFont);
- SetFontItalic(false);
- SetFontSize(FontSize);
- SetFontReflection(false, 0);
-
- // draw text
- TextLen := glTextWidth(Theme.Sing.LineBonusText[PopUp.Rating]);
-
- // color and pos
- SetFontPos (X + (W - TextLen) / 2, Y + FontOffset);
- glColor4f(1, 1, 1, Alpha);
-
- // draw
- glPrint(Theme.Sing.LineBonusText[PopUp.Rating]);
- end; // eo alpha check
- end; // eo right screen
- end; // eo player has position
- end
- else
- Log.LogError('TSingScores: Try to draw a non-existing popup');
-end;
-
-{**
- * draws a score by playerindex
- *}
-procedure TSingScores.DrawScore(const Index: integer);
-var
- Position: PScorePosition;
- ScoreStr: String;
-begin
- // only draw if player has a position
- if Players[Index].Position <> High(byte) then
- begin
- // only draw if player is on cur screen
- if (((Players[Index].Position and 128) = 0) = (ScreenAct = 1)) and Players[Index].Visible then
- begin
- Position := @Positions[Players[Index].Position and 127];
-
- // draw scorebg
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
-
- glColor4f(1,1,1, 1);
- glBindTexture(GL_TEXTURE_2D, Players[Index].ScoreBG.TexNum);
-
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Position.BGX, Position.BGY);
- glTexCoord2f(0, Players[Index].ScoreBG.TexH); glVertex2f(Position.BGX, Position.BGY + Position.BGH);
- glTexCoord2f(Players[Index].ScoreBG.TexW, Players[Index].ScoreBG.TexH); glVertex2f(Position.BGX + Position.BGW, Position.BGY + Position.BGH);
- glTexCoord2f(Players[Index].ScoreBG.TexW, 0); glVertex2f(Position.BGX + Position.BGW, Position.BGY);
- glEnd;
-
- glDisable(GL_TEXTURE_2D);
- glDisable(GL_BLEND);
-
- // draw score text
- SetFontStyle(Position.TextFont);
- SetFontItalic(false);
- SetFontSize(Position.TextSize);
- SetFontPos(Position.TextX, Position.TextY);
- SetFontReflection(false, 0);
-
- ScoreStr := InttoStr(Players[Index].ScoreDisplayed div 10) + '0';
- while (Length(ScoreStr) < 5) do
- ScoreStr := '0' + ScoreStr;
-
- glPrint(ScoreStr);
-
- end; // eo right screen
- end; // eo player has position
-end;
-
-
-procedure TSingScores.DrawRatingBar(const Index: integer);
-var
- Position: PScorePosition;
- R, G, B: real;
- Size, Diff: real;
-begin
- // only draw if player has a position
- if Players[Index].Position <> High(byte) then
- begin
- // only draw if player is on cur screen
- if (((Players[Index].Position and 128) = 0) = (ScreenAct = 1) and
- Players[index].RBVisible and
- Players[index].Visible) then
- begin
- Position := @Positions[Players[Index].Position and 127];
-
- if (Enabled and Players[Index].Enabled) then
- begin
- // move position if enabled
- Diff := Players[Index].RBTarget - Players[Index].RBPos;
- if (Abs(Diff) < 0.02) then
- aPlayers[Index].RBPos := aPlayers[Index].RBTarget
- else
- aPlayers[Index].RBPos := aPlayers[Index].RBPos + Diff*0.1;
- end;
-
- // get colors for rating bar
- if (Players[index].RBPos <= 0.22) then
- begin
- R := 1;
- G := 0;
- B := 0;
- end
- else if (Players[index].RBPos <= 0.42) then
- begin
- R := 1;
- G := Players[index].RBPos * 5;
- B := 0;
- end
- else if (Players[index].RBPos <= 0.57) then
- begin
- R := 1;
- G := 1;
- B := 0;
- end
- else if (Players[index].RBPos <= 0.77) then
- begin
- R := 1 - (Players[index].RBPos - 0.57) * 5;
- G := 1;
- B := 0;
- end
- else
- begin
- R := 0;
- G := 1;
- B := 0;
- end;
-
- // enable all glfuncs needed
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
-
- // draw rating bar bg
- glColor4f(1, 1, 1, 0.8);
- glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_BG_Tex.TexNum);
-
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0);
- glVertex2f(Position.RBX, Position.RBY);
-
- glTexCoord2f(0, Settings.RatingBar_BG_Tex.TexH);
- glVertex2f(Position.RBX, Position.RBY+Position.RBH);
-
- glTexCoord2f(Settings.RatingBar_BG_Tex.TexW, Settings.RatingBar_BG_Tex.TexH);
- glVertex2f(Position.RBX+Position.RBW, Position.RBY+Position.RBH);
-
- glTexCoord2f(Settings.RatingBar_BG_Tex.TexW, 0);
- glVertex2f(Position.RBX+Position.RBW, Position.RBY);
- glEnd;
-
- // draw rating bar itself
- Size := Position.RBX + Position.RBW * Players[Index].RBPos;
- glColor4f(R, G, B, 1);
- glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_Bar_Tex.TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0);
- glVertex2f(Position.RBX, Position.RBY);
-
- glTexCoord2f(0, Settings.RatingBar_Bar_Tex.TexH);
- glVertex2f(Position.RBX, Position.RBY + Position.RBH);
-
- glTexCoord2f(Settings.RatingBar_Bar_Tex.TexW, Settings.RatingBar_Bar_Tex.TexH);
- glVertex2f(Size, Position.RBY + Position.RBH);
-
- glTexCoord2f(Settings.RatingBar_Bar_Tex.TexW, 0);
- glVertex2f(Size, Position.RBY);
- glEnd;
-
- // draw rating bar fg (the thing with the 3 lines to get better readability)
- glColor4f(1, 1, 1, 0.6);
- glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_FG_Tex.TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0);
- glVertex2f(Position.RBX, Position.RBY);
-
- glTexCoord2f(0, Settings.RatingBar_FG_Tex.TexH);
- glVertex2f(Position.RBX, Position.RBY + Position.RBH);
-
- glTexCoord2f(Settings.RatingBar_FG_Tex.TexW, Settings.RatingBar_FG_Tex.TexH);
- glVertex2f(Position.RBX + Position.RBW, Position.RBY + Position.RBH);
-
- glTexCoord2f(Settings.RatingBar_FG_Tex.TexW, 0);
- glVertex2f(Position.RBX + Position.RBW, Position.RBY);
- glEnd;
-
- // disable all enabled glfuncs
- glDisable(GL_TEXTURE_2D);
- glDisable(GL_BLEND);
- end; // eo Right Screen
- end; // eo Player has Position
-end;
-
-end.
diff --git a/src/base/USkins.pas b/src/base/USkins.pas
deleted file mode 100644
index 6ef5c596..00000000
--- a/src/base/USkins.pas
+++ /dev/null
@@ -1,220 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit USkins;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- UPath;
-
-type
- TSkinTexture = record
- Name: string;
- FileName: IPath;
- end;
-
- TSkinEntry = record
- Theme: string;
- Name: string;
- Path: IPath;
- FileName: IPath;
- Creator: string; // not used yet
- end;
-
- TSkin = class
- Skin: array of TSkinEntry;
- SkinTexture: array of TSkinTexture;
- SkinPath: IPath;
- Color: integer;
- constructor Create;
- procedure LoadList;
- procedure ParseDir(Dir: IPath);
- procedure LoadHeader(FileName: IPath);
- procedure LoadSkin(Name: string);
- function GetTextureFileName(TextureName: string): IPath;
- function GetSkinNumber(Name: string): integer;
- procedure onThemeChange;
- end;
-
-var
- Skin: TSkin;
-
-implementation
-
-uses
- IniFiles,
- Classes,
- SysUtils,
- UIni,
- ULog,
- UMain,
- UPathUtils,
- UFileSystem;
-
-constructor TSkin.Create;
-begin
- inherited;
- LoadList;
-// LoadSkin('...');
-// SkinColor := Color;
-end;
-
-procedure TSkin.LoadList;
-var
- Iter: IFileIterator;
- DirInfo: TFileInfo;
-begin
- Iter := FileSystem.FileFind(SkinsPath.Append('*'), faDirectory);
- while Iter.HasNext do
- begin
- DirInfo := Iter.Next();
- if (not DirInfo.Name.Equals('.')) and (not DirInfo.Name.Equals('..')) then
- ParseDir(SkinsPath.Append(DirInfo.Name, pdAppend));
- end;
-end;
-
-procedure TSkin.ParseDir(Dir: IPath);
-var
- Iter: IFileIterator;
- IniInfo: TFileInfo;
-begin
- Iter := FileSystem.FileFind(Dir.Append('*.ini'), 0);
- while Iter.HasNext do
- begin
- IniInfo := Iter.Next;
- LoadHeader(Dir.Append(IniInfo.Name));
- end;
-end;
-
-procedure TSkin.LoadHeader(FileName: IPath);
-var
- SkinIni: TMemIniFile;
- S: integer;
-begin
- SkinIni := TMemIniFile.Create(FileName.ToNative);
-
- S := Length(Skin);
- SetLength(Skin, S+1);
-
- Skin[S].Path := FileName.GetPath;
- Skin[S].FileName := FileName.GetName;
- Skin[S].Theme := SkinIni.ReadString('Skin', 'Theme', '');
- Skin[S].Name := SkinIni.ReadString('Skin', 'Name', '');
- Skin[S].Creator := SkinIni.ReadString('Skin', 'Creator', '');
-
- SkinIni.Free;
-end;
-
-procedure TSkin.LoadSkin(Name: string);
-var
- SkinIni: TMemIniFile;
- SL: TStringList;
- T: integer;
- S: integer;
-begin
- S := GetSkinNumber(Name);
- SkinPath := Skin[S].Path;
-
- SkinIni := TMemIniFile.Create(SkinPath.Append(Skin[S].FileName).ToNative);
-
- SL := TStringList.Create;
- SkinIni.ReadSection('Textures', SL);
-
- SetLength(SkinTexture, SL.Count);
- for T := 0 to SL.Count-1 do
- begin
- SkinTexture[T].Name := SL.Strings[T];
- SkinTexture[T].FileName := Path(SkinIni.ReadString('Textures', SL.Strings[T], ''));
- end;
-
- SL.Free;
- SkinIni.Free;
-end;
-
-function TSkin.GetTextureFileName(TextureName: string): IPath;
-var
- T: integer;
-begin
- Result := PATH_NONE;
-
- for T := 0 to High(SkinTexture) do
- begin
- if (SkinTexture[T].Name = TextureName) and
- (SkinTexture[T].FileName.IsSet) then
- begin
- Result := SkinPath.Append(SkinTexture[T].FileName);
- end;
- end;
-
- if (TextureName <> '') and (Result.IsSet) then
- begin
- //Log.LogError('', '-----------------------------------------');
- //Log.LogError(TextureName+' - '+ Result, 'TSkin.GetTextureFileName');
- end;
-
-{ Result := SkinPath + 'Bar.jpg';
- if TextureName = 'Ball' then
- Result := SkinPath + 'Ball.bmp';
- if Copy(TextureName, 1, 4) = 'Gray' then
- Result := SkinPath + 'Ball.bmp';
- if Copy(TextureName, 1, 6) = 'NoteBG' then
- Result := SkinPath + 'Ball.bmp';}
-end;
-
-function TSkin.GetSkinNumber(Name: string): integer;
-var
- S: integer;
-begin
- Result := 0; // set default to the first available skin
- for S := 0 to High(Skin) do
- if Skin[S].Name = Name then
- Result := S;
-end;
-
-procedure TSkin.onThemeChange;
-var
- S: integer;
- Name: String;
-begin
- Ini.SkinNo:=0;
- SetLength(ISkin, 0);
- Name := Uppercase(ITheme[Ini.Theme]);
- for S := 0 to High(Skin) do
- if Name = Uppercase(Skin[S].Theme) then
- begin
- SetLength(ISkin, Length(ISkin)+1);
- ISkin[High(ISkin)] := Skin[S].Name;
- end;
-
-end;
-
-end.
diff --git a/src/base/USong.pas b/src/base/USong.pas
deleted file mode 100644
index 705206c4..00000000
--- a/src/base/USong.pas
+++ /dev/null
@@ -1,1348 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit USong;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- {$IFDEF MSWINDOWS}
- Windows,
- {$ELSE}
- {$IFNDEF DARWIN}
- syscall,
- {$ENDIF}
- baseunix,
- UnixType,
- {$ENDIF}
- SysUtils,
- Classes,
- UPlatform,
- ULog,
- UTexture,
- UCommon,
- {$IFDEF DARWIN}
- cthreads,
- {$ENDIF}
- {$IFDEF USE_PSEUDO_THREAD}
- PseudoThread,
- {$ENDIF}
- UCatCovers,
- UXMLSong,
- UUnicodeUtils,
- UTextEncoding,
- UFilesystem,
- UPath;
-
-type
-
- TSingMode = ( smNormal, smPartyMode, smPlaylistRandom );
-
- TBPM = record
- BPM: real;
- StartBeat: real;
- end;
-
- TScore = record
- Name: UTF8String;
- Score: integer;
- Date: UTF8String;
- end;
-
- { used to hold header tags that are not supported by this version of
- usdx (e.g. some tags from ultrastar 0.7.0) when songs are loaded in
- songeditor. They will be written the end of the song header }
- TCustomHeaderTag = record
- Tag: UTF8String;
- Content: UTF8String;
- end;
-
- TSong = class
- private
- FileLineNo : integer; // line, which is read last, for error reporting
-
- function DecodeFilename(Filename: RawByteString): IPath;
- function Solmizate(Note: integer; Type_: integer): string;
- procedure ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: UTF8String);
- procedure NewSentence(LineNumberP: integer; Param1, Param2: integer);
-
- function ParseLyricStringParam(const Line: RawByteString; var LinePos: integer): RawByteString;
- function ParseLyricIntParam(const Line: RawByteString; var LinePos: integer): integer;
- function ParseLyricFloatParam(const Line: RawByteString; var LinePos: integer): extended;
- function ParseLyricCharParam(const Line: RawByteString; var LinePos: integer): AnsiChar;
- function ParseLyricText(const Line: RawByteString; var LinePos: integer): RawByteString;
-
- function ReadTXTHeader(SongFile: TTextFileStream; ReadCustomTags: Boolean): boolean;
- function ReadXMLHeader(const aFileName: IPath): boolean;
-
- function GetFolderCategory(const aFileName: IPath): UTF8String;
- function FindSongFile(Dir: IPath; Mask: UTF8String): IPath;
- public
- Path: IPath; // kust path component of file (only set if file was found)
- Folder: UTF8String; // for sorting by folder (only set if file was found)
- FileName: IPath; // just name component of file (only set if file was found)
-
- // filenames
- Cover: IPath;
- Mp3: IPath;
- Background: IPath;
- Video: IPath;
-
- // sorting methods
- Genre: UTF8String;
- Edition: UTF8String;
- Language: UTF8String;
- Year: Integer;
-
- Title: UTF8String;
- Artist: UTF8String;
-
- Creator: UTF8String;
-
- CoverTex: TTexture;
-
- VideoGAP: real;
- NotesGAP: integer;
- Start: real; // in seconds
- Finish: integer; // in miliseconds
- Relative: boolean;
- Resolution: integer;
- BPM: array of TBPM;
- GAP: real; // in miliseconds
-
- Encoding: TEncoding;
-
- CustomTags: array of TCustomHeaderTag;
-
- Score: array[0..2] of array of TScore;
-
- // these are used when sorting is enabled
- Visible: boolean; // false if hidden, true if visible
- Main: boolean; // false for songs, true for category buttons
- OrderNum: integer; // has a number of category for category buttons and songs
- OrderTyp: integer; // type of sorting for this button (0=name)
- CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs
-
- Base : array[0..1] of integer;
- Rel : array[0..1] of integer;
- Mult : integer;
- MultBPM : integer;
-
- LastError: AnsiString;
- function GetErrorLineNo: integer;
- property ErrorLineNo: integer read GetErrorLineNo;
-
-
- constructor Create(); overload;
- constructor Create(const aFileName : IPath); overload;
- function LoadSong: boolean;
- function LoadXMLSong: boolean;
- function Analyse(const ReadCustomTags: Boolean = false): boolean;
- function AnalyseXML(): boolean;
- procedure Clear();
- end;
-
-implementation
-
-uses
- StrUtils,
- TextGL,
- UIni,
- UPathUtils,
- UMusic, //needed for Lines
- UNote; //needed for Player
-
-const
- DEFAULT_ENCODING = encAuto;
-
-constructor TSong.Create();
-begin
- inherited;
-
- // to-do : special create for category "songs"
- //dirty fix to fix folders=on
- Self.Path := PATH_NONE();
- Self.FileName := PATH_NONE();
- Self.Cover := PATH_NONE();
- Self.Mp3 := PATH_NONE();
- Self.Background:= PATH_NONE();
- Self.Video := PATH_NONE();
-end;
-
-// This may be changed, when we rewrite song select code.
-// it is some kind of dirty, but imho the best possible
-// solution as we do atm not support nested categorys.
-// it works like the folder sorting in 1.0.1a
-// folder is set to the first folder under the songdir
-// so songs ~/.ultrastardx/songs/punk is in the same
-// category as songs in shared/ultrastardx/songs are.
-// note: folder is just the name of a category it has
-// nothing to do with the path used for file loading
-function TSong.GetFolderCategory(const aFileName: IPath): UTF8String;
-var
- I: Integer;
- CurSongPath: IPath;
- CurSongPathRel: IPath;
-begin
- Result := 'Unknown'; //default folder category, if we can't locate the song dir
-
- for I := 0 to SongPaths.Count-1 do
- begin
- CurSongPath := SongPaths[I] as IPath;
- if (aFileName.IsChildOf(CurSongPath, false)) then
- begin
- if (aFileName.IsChildOf(CurSongPath, true)) then
- begin
- // songs are in the "root" of the songdir => use songdir for the categorys name
- Result := CurSongPath.RemovePathDelim.ToUTF8;
- end
- else
- begin
- // use the first subdirectory below CurSongPath as the category name
- CurSongPathRel := aFileName.GetRelativePath(CurSongPath.AppendPathDelim);
- Result := CurSongPathRel.SplitDirs[0].RemovePathDelim.ToUTF8;
- end;
- Exit;
- end;
- end;
-end;
-
-constructor TSong.Create(const aFileName: IPath);
-begin
- inherited Create();
-
- Mult := 1;
- MultBPM := 4;
-
- LastError := '';
-
- Self.Path := aFileName.GetPath;
- Self.FileName := aFileName.GetName;
- Self.Folder := GetFolderCategory(aFileName);
-
- (*
- if (aFileName.IsFile) then
- begin
- if ReadTXTHeader(aFileName) then
- begin
- LoadSong();
- end
- else
- begin
- Log.LogError('Error Loading SongHeader, abort Song Loading');
- Exit;
- end;
- end;
- *)
-end;
-
-function TSong.FindSongFile(Dir: IPath; Mask: UTF8String): IPath;
-var
- Iter: IFileIterator;
- FileInfo: TFileInfo;
- FileName: IPath;
-begin
- Iter := FileSystem.FileFind(Dir.Append(Mask), faDirectory);
- if (Iter.HasNext) then
- Result := Iter.Next.Name
- else
- Result := PATH_NONE;
-end;
-
-function TSong.DecodeFilename(Filename: RawByteString): IPath;
-begin
- Result := UPath.Path(DecodeStringUTF8(Filename, Encoding));
-end;
-
-type
- EUSDXParseException = class(Exception);
-
-{**
- * Parses the Line string starting from LinePos for a parameter.
- * Leading whitespace is trimmed, same applies to the first trailing whitespace.
- * After the call LinePos will point to the position after the first trailing
- * whitespace.
- *
- * Raises an EUSDXParseException if no string was found.
- *
- * Example:
- * ParseLyricParam(Line:'Param0 Param1 Param2', LinePos:8, ...)
- * -> Param:'Param1', LinePos:16 (= start of 'Param2')
- *}
-function TSong.ParseLyricStringParam(const Line: RawByteString; var LinePos: integer): RawByteString;
-var
- Start: integer;
- OldLinePos: integer;
-const
- Whitespace = [#9, ' '];
-begin
- OldLinePos := LinePos;
-
- Start := 0;
- while (LinePos <= Length(Line)) do
- begin
- if (Line[LinePos] in Whitespace) then
- begin
- // check for end of param
- if (Start > 0) then
- Break;
- end
- // check for beginning of param
- else if (Start = 0) then
- begin
- Start := LinePos;
- end;
- Inc(LinePos);
- end;
-
- // check if param was found
- if (Start = 0) then
- begin
- LinePos := OldLinePos;
- raise EUSDXParseException.Create('String expected');
- end
- else
- begin
- // copy param without trailing whitespace
- Result := Copy(Line, Start, LinePos-Start);
- // skip first trailing whitespace (if not at EOL)
- if (LinePos <= Length(Line)) then
- Inc(LinePos);
- end;
-end;
-
-function TSong.ParseLyricIntParam(const Line: RawByteString; var LinePos: integer): integer;
-var
- Str: RawByteString;
- OldLinePos: integer;
-begin
- OldLinePos := LinePos;
- Str := ParseLyricStringParam(Line, LinePos);
-
- if not TryStrToInt(Str, Result) then
- begin // on convert error
- Result := 0;
- LinePos := OldLinePos;
- raise EUSDXParseException.Create('Integer expected');
- end;
-end;
-
-function TSong.ParseLyricFloatParam(const Line: RawByteString; var LinePos: integer): extended;
-var
- Str: RawByteString;
- OldLinePos: integer;
-begin
- OldLinePos := LinePos;
- Str := ParseLyricStringParam(Line, LinePos);
-
- if not TryStrToFloat(Str, Result) then
- begin // on convert error
- Result := 0;
- LinePos := OldLinePos;
- raise EUSDXParseException.Create('Float expected');
- end;
-end;
-
-function TSong.ParseLyricCharParam(const Line: RawByteString; var LinePos: integer): AnsiChar;
-var
- Str: RawByteString;
- OldLinePos: integer;
-begin
- OldLinePos := LinePos;
- Str := ParseLyricStringParam(Line, LinePos);
- if (Length(Str) <> 1) then
- begin
- { to-do : decide what to do here
- usdx < 1.1 does not nead a whitespace after a char param
- so we may just write a warning to error.log and use the
- first non whitespace character instead of raising an
- exception that causes the song not to load. So the more
- error resistant code is:
- LinePos := OldLinePos + 1;
- // raise EUSDXParseException.Create('Character expected'); }
- LinePos := OldLinePos;
- raise EUSDXParseException.Create('Character expected');
- end;
- Result := Str[1];
-end;
-
-{**
- * Returns the rest of the line from LinePos as lyric text.
- * Leading and trailing whitespace is not trimmed.
- *}
-function TSong.ParseLyricText(const Line: RawByteString; var LinePos: integer): RawByteString;
-begin
- if (LinePos > Length(Line)) then
- Result := ''
- else
- begin
- Result := Copy(Line, LinePos, Length(Line)-LinePos+1);
- LinePos := Length(Line)+1;
- end;
-end;
-
-//Load TXT Song
-function TSong.LoadSong(): boolean;
-var
- CurLine: RawByteString;
- LinePos: integer;
- Count: integer;
- Both: boolean;
-
- Param0: AnsiChar;
- Param1: integer;
- Param2: integer;
- Param3: integer;
- ParamLyric: UTF8String;
-
- I: integer;
- NotesFound: boolean;
- SongFile: TTextFileStream;
- FileNamePath: IPath;
-begin
- Result := false;
- LastError := '';
-
- FileNamePath := Path.Append(FileName);
- if not FileNamePath.IsFile() then
- begin
- LastError := 'ERROR_CORRUPT_SONG_FILE_NOT_FOUND';
- Log.LogError('File not found: "' + FileNamePath.ToNative + '"', 'TSong.LoadSong()');
- Exit;
- end;
-
- MultBPM := 4; // multiply beat-count of note by 4
- Mult := 1; // accuracy of measurement of note
- Rel[0] := 0;
- Both := false;
-
- if Length(Player) = 2 then
- Both := true;
-
- try
- // Open song file for reading.....
- SongFile := TMemTextFileStream.Create(FileNamePath, fmOpenRead);
- try
- //Search for Note Beginning
- FileLineNo := 0;
- NotesFound := false;
- while (SongFile.ReadLine(CurLine)) do
- begin
- Inc(FileLineNo);
- if (Length(CurLine) > 0) and (CurLine[1] in [':', 'F', '*']) then
- begin
- NotesFound := true;
- Break;
- end;
- end;
-
- if (not NotesFound) then
- begin //Song File Corrupted - No Notes
- Log.LogError('Could not load txt File, no notes found: ' + FileNamePath.ToNative);
- LastError := 'ERROR_CORRUPT_SONG_NO_NOTES';
- Exit;
- end;
-
- SetLength(Lines, 2);
- for Count := 0 to High(Lines) do
- begin
- Lines[Count].High := 0;
- Lines[Count].Number := 1;
- Lines[Count].Current := 0;
- Lines[Count].Resolution := self.Resolution;
- Lines[Count].NotesGAP := self.NotesGAP;
- Lines[Count].ScoreValue := 0;
-
- //Add first line and set some standard values to fields
- //see procedure NewSentence for further explantation
- //concerning most of these values
- SetLength(Lines[Count].Line, 1);
- Lines[Count].Line[0].HighNote := -1;
- Lines[Count].Line[0].LastLine := false;
- Lines[Count].Line[0].BaseNote := High(Integer);
- Lines[Count].Line[0].TotalNotes := 0;
- end;
-
- while true do
- begin
- LinePos := 1;
-
- Param0 := ParseLyricCharParam(CurLine, LinePos);
- if (Param0 = 'E') then
- begin
- Break
- end
- else if (Param0 in [':', '*', 'F']) then
- begin
- // read notes
- Param1 := ParseLyricIntParam(CurLine, LinePos);
- Param2 := ParseLyricIntParam(CurLine, LinePos);
- Param3 := ParseLyricIntParam(CurLine, LinePos);
- ParamLyric := ParseLyricText(CurLine, LinePos);
-
- //Check for ZeroNote
- if Param2 = 0 then
- Log.LogWarn(Format('"%s" in line %d: %s',
- [FileNamePath.ToNative, FileLineNo, 'found note with length zero -> note ignored']), 'TSong.LoadSong')
- //Log.LogError('Found zero-length note at "'+Param0+' '+IntToStr(Param1)+' '+IntToStr(Param2)+' '+IntToStr(Param3)+ParamLyric+'" -> Note ignored!')
- else
- begin
- // add notes
- if not Both then
- // P1
- ParseNote(0, Param0, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamLyric)
- else
- begin
- // P1 + P2
- ParseNote(0, Param0, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamLyric);
- ParseNote(1, Param0, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamLyric);
- end;
- end; //Zeronote check
- end // if
-
- else if Param0 = '-' then
- begin
- // reads sentence
- Param1 := ParseLyricIntParam(CurLine, LinePos);
- if self.Relative then
- Param2 := ParseLyricIntParam(CurLine, LinePos); // read one more data for relative system
-
- // new sentence
- if not Both then
- // P1
- NewSentence(0, (Param1 + Rel[0]) * Mult, Param2)
- else
- begin
- // P1 + P2
- NewSentence(0, (Param1 + Rel[0]) * Mult, Param2);
- NewSentence(1, (Param1 + Rel[1]) * Mult, Param2);
- end;
- end // if
-
- else if Param0 = 'B' then
- begin
- SetLength(self.BPM, Length(self.BPM) + 1);
- self.BPM[High(self.BPM)].StartBeat := ParseLyricFloatParam(CurLine, LinePos);
- self.BPM[High(self.BPM)].StartBeat := self.BPM[High(self.BPM)].StartBeat + Rel[0];
-
- self.BPM[High(self.BPM)].BPM := ParseLyricFloatParam(CurLine, LinePos);
- self.BPM[High(self.BPM)].BPM := self.BPM[High(self.BPM)].BPM * Mult * MultBPM;
- end;
-
- // Read next line in File
- if (not SongFile.ReadLine(CurLine)) then
- Break;
-
- Inc(FileLineNo);
- end; // while
- finally
- SongFile.Free;
- end;
- except
- on E: Exception do
- begin
- Log.LogError(Format('Error loading file: "%s" in line %d,%d: %s',
- [FileNamePath.ToNative, FileLineNo, LinePos, E.Message]));
- Exit;
- end;
- end;
-
- for I := 0 to High(Lines) do
- begin
- if ((Both) or (I = 0)) then
- begin
- if (Length(Lines[I].Line) < 2) then
- begin
- LastError := 'ERROR_CORRUPT_SONG_NO_BREAKS';
- Log.LogError('Error loading file: Can''t find any linebreaks in "' + FileNamePath.ToNative + '"');
- exit;
- end;
-
- if (Lines[I].Line[Lines[I].High].HighNote < 0) then
- begin
- SetLength(Lines[I].Line, Lines[I].Number - 1);
- Lines[I].High := Lines[I].High - 1;
- Lines[I].Number := Lines[I].Number - 1;
- Log.LogError('Error loading Song, sentence w/o note found in last line before E: ' + FileNamePath.ToNative);
- end;
- end;
- end;
-
- for Count := 0 to High(Lines) do
- begin
- if (High(Lines[Count].Line) >= 0) then
- Lines[Count].Line[High(Lines[Count].Line)].LastLine := true;
- end;
-
- Result := true;
-end;
-
-//Load XML Song
-function TSong.LoadXMLSong(): boolean;
-var
- Count: integer;
- Both: boolean;
- Param1: integer;
- Param2: integer;
- Param3: integer;
- ParamS: string;
- I, J: integer;
- NoteIndex: integer;
-
- NoteType: char;
- SentenceEnd, Rest, Time: integer;
- Parser: TParser;
- FileNamePath: IPath;
-begin
- Result := false;
- LastError := '';
-
- FileNamePath := Path.Append(FileName);
- if not FileNamePath.IsFile() then
- begin
- Log.LogError('File not found: "' + FileNamePath.ToNative + '"', 'TSong.LoadSong()');
- exit;
- end;
-
- MultBPM := 4; // multiply beat-count of note by 4
- Mult := 1; // accuracy of measurement of note
- Lines[0].ScoreValue := 0;
- self.Relative := false;
- Rel[0] := 0;
- Both := false;
-
- if Length(Player) = 2 then
- Both := true;
-
- Parser := TParser.Create;
- Parser.Settings.DashReplacement := '~';
-
- for Count := 0 to High(Lines) do
- begin
- Lines[Count].High := 0;
- Lines[Count].Number := 1;
- Lines[Count].Current := 0;
- Lines[Count].Resolution := self.Resolution;
- Lines[Count].NotesGAP := self.NotesGAP;
- Lines[Count].ScoreValue := 0;
-
- //Add first line and set some standard values to fields
- //see procedure NewSentence for further explantation
- //concerning most of these values
- SetLength(Lines[Count].Line, 1);
- Lines[Count].Line[0].HighNote := -1;
- Lines[Count].Line[0].LastLine := false;
- Lines[Count].Line[0].BaseNote := High(Integer);
- Lines[Count].Line[0].TotalNotes := 0;
- end;
-
- //Try to Parse the Song
-
- if Parser.ParseSong(FileNamePath) then
- begin
- //Writeln('XML Inputfile Parsed succesful');
-
- //Start write parsed information to Song
- //Notes Part
- for I := 0 to High(Parser.SongInfo.Sentences) do
- begin
- //Add Notes
- for J := 0 to High(Parser.SongInfo.Sentences[I].Notes) do
- begin
- case Parser.SongInfo.Sentences[I].Notes[J].NoteTyp of
- NT_Normal: NoteType := ':';
- NT_Golden: NoteType := '*';
- NT_Freestyle: NoteType := 'F';
- end;
-
- Param1:=Parser.SongInfo.Sentences[I].Notes[J].Start; //Note Start
- Param2:=Parser.SongInfo.Sentences[I].Notes[J].Duration; //Note Duration
- Param3:=Parser.SongInfo.Sentences[I].Notes[J].Tone; //Note Tone
- ParamS:=' ' + Parser.SongInfo.Sentences[I].Notes[J].Lyric; //Note Lyric
-
- if not Both then
- // P1
- ParseNote(0, NoteType, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS)
- else
- begin
- // P1 + P2
- ParseNote(0, NoteType, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS);
- ParseNote(1, NoteType, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS);
- end;
-
- end; //J Forloop
-
- //Add Sentence break
- if (I < High(Parser.SongInfo.Sentences)) then
- begin
- SentenceEnd := Parser.SongInfo.Sentences[I].Notes[High(Parser.SongInfo.Sentences[I].Notes)].Start + Parser.SongInfo.Sentences[I].Notes[High(Parser.SongInfo.Sentences[I].Notes)].Duration;
- Rest := Parser.SongInfo.Sentences[I+1].Notes[0].Start - SentenceEnd;
-
- //Calculate Time
- case Rest of
- 0, 1: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start;
- 2: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 1;
- 3: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 2;
- else
- if (Rest >= 4) then
- Time := SentenceEnd + 2
- else //Sentence overlapping :/
- Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start;
- end;
- // new sentence
- if not Both then // P1
- NewSentence(0, (Time + Rel[0]) * Mult, Param2)
- else
- begin // P1 + P2
- NewSentence(0, (Time + Rel[0]) * Mult, Param2);
- NewSentence(1, (Time + Rel[1]) * Mult, Param2);
- end;
-
- end;
- end;
- //End write parsed information to Song
- Parser.Free;
- end
- else
- begin
- Log.LogError('Could not parse inputfile: ' + FileNamePath.ToNative);
- exit;
- end;
-
- for Count := 0 to High(Lines) do
- begin
- Lines[Count].Line[High(Lines[Count].Line)].LastLine := true;
- end;
-
- Result := true;
-end;
-
-function TSong.ReadXMLHeader(const aFileName : IPath): boolean;
-var
- Done : byte;
- Parser : TParser;
- FileNamePath: IPath;
-begin
- Result := true;
- Done := 0;
-
- //Parse XML
- Parser := TParser.Create;
- Parser.Settings.DashReplacement := '~';
-
- FileNamePath := Self.Path.Append(Self.FileName);
- if Parser.ParseSong(FileNamePath) then
- begin
- //-----------
- //Required Attributes
- //-----------
-
- //Title
- self.Title := Parser.SongInfo.Header.Title;
-
- //Add Title Flag to Done
- Done := Done or 1;
-
- //Artist
- self.Artist := Parser.SongInfo.Header.Artist;
-
- //Add Artist Flag to Done
- Done := Done or 2;
-
- //MP3 File //Test if Exists
- Self.Mp3 := FindSongFile(Self.Path, '*.mp3');
- //Add Mp3 Flag to Done
- if (Self.Path.Append(Self.Mp3).IsFile()) then
- Done := Done or 4;
-
- //Beats per Minute
- SetLength(self.BPM, 1);
- self.BPM[0].StartBeat := 0;
-
- self.BPM[0].BPM := (Parser.SongInfo.Header.BPM * Parser.SongInfo.Header.Resolution/4 ) * Mult * MultBPM;
-
- //Add BPM Flag to Done
- if self.BPM[0].BPM <> 0 then
- Done := Done or 8;
-
- //---------
- //Additional Header Information
- //---------
-
- // Gap
- self.GAP := Parser.SongInfo.Header.Gap;
-
- //Cover Picture
- self.Cover := FindSongFile(Path, '*[CO].jpg');
-
- //Background Picture
- self.Background := FindSongFile(Path, '*[BG].jpg');
-
- // Video File
- // self.Video := Value
-
- // Video Gap
- // self.VideoGAP := StrtoFloatI18n( Value )
-
- //Genre Sorting
- self.Genre := Parser.SongInfo.Header.Genre;
-
- //Edition Sorting
- self.Edition := Parser.SongInfo.Header.Edition;
-
- //Year Sorting
- //Parser.SongInfo.Header.Year
-
- //Language Sorting
- self.Language := Parser.SongInfo.Header.Language;
- end
- else
- Log.LogError('File incomplete or not SingStar XML (A): ' + aFileName.ToNative);
-
- Parser.Free;
-
- //Check if all Required Values are given
- if (Done <> 15) then
- begin
- Result := false;
- if (Done and 8) = 0 then //No BPM Flag
- Log.LogError('BPM tag missing: ' + self.FileName.ToNative)
- else if (Done and 4) = 0 then //No MP3 Flag
- Log.LogError('MP3 tag/file missing: ' + self.FileName.ToNative)
- else if (Done and 2) = 0 then //No Artist Flag
- Log.LogError('Artist tag missing: ' + self.FileName.ToNative)
- else if (Done and 1) = 0 then //No Title Flag
- Log.LogError('Title tag missing: ' + self.FileName.ToNative)
- else //unknown Error
- Log.LogError('File incomplete or not SingStar XML (B - '+ inttostr(Done) +'): ' + aFileName.ToNative);
- end;
-
-end;
-
-{**
- * "International" StrToFloat variant. Uses either ',' or '.' as decimal
- * separator.
- *}
-function StrToFloatI18n(const Value: string): extended;
-var
- TempValue : string;
-begin
- TempValue := Value;
- if (Pos(',', TempValue) <> 0) then
- TempValue[Pos(',', TempValue)] := '.';
- Result := StrToFloatDef(TempValue, 0);
-end;
-
-function TSong.ReadTXTHeader(SongFile: TTextFileStream; ReadCustomTags: Boolean): boolean;
-var
- Line, Identifier: string;
- Value: string;
- SepPos: integer; // separator position
- Done: byte; // bit-vector of mandatory fields
- EncFile: IPath; // encoded filename
- FullFileName: string;
-
- { adds a custom header tag to the song
- if there is no ':' in the read line, Tag should be empty
- and the whole line should be in Content }
- procedure AddCustomTag(const Tag, Content: String);
- var Len: Integer;
- begin
- if ReadCustomTags then
- begin
- Len := Length(CustomTags);
- SetLength(CustomTags, Len + 1);
- CustomTags[Len].Tag := DecodeStringUTF8(Tag, Encoding);
- CustomTags[Len].Content := DecodeStringUTF8(Content, Encoding);
- end;
- end;
-begin
- Result := true;
- Done := 0;
-
- FullFileName := Path.Append(Filename).ToNative;
-
- //Read first Line
- SongFile.ReadLine(Line);
- if (Length(Line) <= 0) then
- begin
- Log.LogError('File starts with empty line: ' + FullFileName,
- 'TSong.ReadTXTHeader');
- Result := false;
- Exit;
- end;
-
- // check if file begins with a UTF-8 BOM, if so set encoding to UTF-8
- if (CheckReplaceUTF8BOM(Line)) then
- Encoding := encUTF8;
-
- //Read Lines while Line starts with # or its empty
- while (Length(Line) = 0) or (Line[1] = '#') do
- begin
- //Increase Line Number
- Inc (FileLineNo);
- SepPos := Pos(':', Line);
-
- //Line has no Seperator, ignore non header field
- if (SepPos = 0) then
- begin
- AddCustomTag('', Copy(Line, 2, Length(Line) - 1));
- // read next line
- if (not SongFile.ReadLine(Line)) then
- begin
- Result := false;
- Log.LogError('File incomplete or not Ultrastar txt (A): ' + FullFileName);
- Break;
- end;
- Continue;
- end;
-
- //Read Identifier and Value
- Identifier := UpperCase(Trim(Copy(Line, 2, SepPos - 2))); //Uppercase is for Case Insensitive Checks
- Value := Trim(Copy(Line, SepPos + 1, Length(Line) - SepPos));
-
- //Check the Identifier (If Value is given)
- if (Length(Value) = 0) then
- begin
- Log.LogWarn('Empty field "'+Identifier+'" in file ' + FullFileName,
- 'TSong.ReadTXTHeader');
- AddCustomTag(Identifier, '');
- end
- else
- begin
-
- //-----------
- //Required Attributes
- //-----------
-
- if (Identifier = 'TITLE') then
- begin
- DecodeStringUTF8(Value, Title, Encoding);
- //Add Title Flag to Done
- Done := Done or 1;
- end
-
- else if (Identifier = 'ARTIST') then
- begin
- DecodeStringUTF8(Value, Artist, Encoding);
- //Add Artist Flag to Done
- Done := Done or 2;
- end
-
- //MP3 File
- else if (Identifier = 'MP3') then
- begin
- EncFile := DecodeFilename(Value);
- if (Self.Path.Append(EncFile).IsFile) then
- begin
- self.Mp3 := EncFile;
-
- //Add Mp3 Flag to Done
- Done := Done or 4;
- end;
- end
-
- //Beats per Minute
- else if (Identifier = 'BPM') then
- begin
- SetLength(self.BPM, 1);
- self.BPM[0].StartBeat := 0;
-
- self.BPM[0].BPM := StrToFloatI18n( Value ) * Mult * MultBPM;
-
- if self.BPM[0].BPM <> 0 then
- begin
- //Add BPM Flag to Done
- Done := Done or 8;
- end;
- end
-
- //---------
- //Additional Header Information
- //---------
-
- // Gap
- else if (Identifier = 'GAP') then
- begin
- self.GAP := StrToFloatI18n(Value);
- end
-
- //Cover Picture
- else if (Identifier = 'COVER') then
- begin
- self.Cover := DecodeFilename(Value);
- end
-
- //Background Picture
- else if (Identifier = 'BACKGROUND') then
- begin
- self.Background := DecodeFilename(Value);
- end
-
- // Video File
- else if (Identifier = 'VIDEO') then
- begin
- EncFile := DecodeFilename(Value);
- if (self.Path.Append(EncFile).IsFile) then
- self.Video := EncFile
- else
- Log.LogError('Can''t find video file in song: ' + FullFileName);
- end
-
- // Video Gap
- else if (Identifier = 'VIDEOGAP') then
- begin
- self.VideoGAP := StrToFloatI18n( Value )
- end
-
- //Genre Sorting
- else if (Identifier = 'GENRE') then
- begin
- DecodeStringUTF8(Value, Genre, Encoding)
- end
-
- //Edition Sorting
- else if (Identifier = 'EDITION') then
- begin
- DecodeStringUTF8(Value, Edition, Encoding)
- end
-
- //Creator Tag
- else if (Identifier = 'CREATOR') then
- begin
- DecodeStringUTF8(Value, Creator, Encoding)
- end
-
- //Language Sorting
- else if (Identifier = 'LANGUAGE') then
- begin
- DecodeStringUTF8(Value, Language, Encoding)
- end
-
- //Language Sorting
- else if (Identifier = 'YEAR') then
- begin
- TryStrtoInt(Value, self.Year)
- end
-
- // Song Start
- else if (Identifier = 'START') then
- begin
- self.Start := StrToFloatI18n( Value )
- end
-
- // Song Ending
- else if (Identifier = 'END') then
- begin
- TryStrtoInt(Value, self.Finish)
- end
-
- // Resolution
- else if (Identifier = 'RESOLUTION') then
- begin
- TryStrtoInt(Value, self.Resolution)
- end
-
- // Notes Gap
- else if (Identifier = 'NOTESGAP') then
- begin
- TryStrtoInt(Value, self.NotesGAP)
- end
-
- // Relative Notes
- else if (Identifier = 'RELATIVE') then
- begin
- if (UpperCase(Value) = 'YES') then
- self.Relative := true;
- end
-
- // File encoding
- else if (Identifier = 'ENCODING') then
- begin
- self.Encoding := ParseEncoding(Value, DEFAULT_ENCODING);
- end
-
- // unsupported tag
- else
- begin
- AddCustomTag(Identifier, Value);
- end;
-
- end; // End check for non-empty Value
-
- // read next line
- if (not SongFile.ReadLine(Line)) then
- begin
- Result := false;
- Log.LogError('File incomplete or not Ultrastar txt (A): ' + FullFileName);
- Break;
- end;
- end; // while
-
- if self.Cover.IsUnset then
- self.Cover := FindSongFile(Path, '*[CO].jpg');
-
- //Check if all Required Values are given
- if (Done <> 15) then
- begin
- Result := false;
- if (Done and 8) = 0 then //No BPM Flag
- Log.LogError('BPM tag missing: ' + FullFileName)
- else if (Done and 4) = 0 then //No MP3 Flag
- Log.LogError('MP3 tag/file missing: ' + FullFileName)
- else if (Done and 2) = 0 then //No Artist Flag
- Log.LogError('Artist tag missing: ' + FullFileName)
- else if (Done and 1) = 0 then //No Title Flag
- Log.LogError('Title tag missing: ' + FullFileName)
- else //unknown Error
- Log.LogError('File incomplete or not Ultrastar txt (B - '+ inttostr(Done) +'): ' + FullFileName);
- end;
-end;
-
-function TSong.GetErrorLineNo: integer;
-begin
- if (LastError='ERROR_CORRUPT_SONG_ERROR_IN_LINE') then
- Result := FileLineNo
- else
- Result := -1;
-end;
-
-function TSong.Solmizate(Note: integer; Type_: integer): string;
-begin
- case (Type_) of
- 1: // european
- begin
- case (Note mod 12) of
- 0..1: Result := ' do ';
- 2..3: Result := ' re ';
- 4: Result := ' mi ';
- 5..6: Result := ' fa ';
- 7..8: Result := ' sol ';
- 9..10: Result := ' la ';
- 11: Result := ' si ';
- end;
- end;
- 2: // japanese
- begin
- case (Note mod 12) of
- 0..1: Result := ' do ';
- 2..3: Result := ' re ';
- 4: Result := ' mi ';
- 5..6: Result := ' fa ';
- 7..8: Result := ' so ';
- 9..10: Result := ' la ';
- 11: Result := ' shi ';
- end;
- end;
- 3: // american
- begin
- case (Note mod 12) of
- 0..1: Result := ' do ';
- 2..3: Result := ' re ';
- 4: Result := ' mi ';
- 5..6: Result := ' fa ';
- 7..8: Result := ' sol ';
- 9..10: Result := ' la ';
- 11: Result := ' ti ';
- end;
- end;
- end; // case
-end;
-
-procedure TSong.ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: UTF8String);
-begin
- if (Ini.Solmization <> 0) then
- LyricS := Solmizate(NoteP, Ini.Solmization);
-
- with Lines[LineNumber].Line[Lines[LineNumber].High] do
- begin
- SetLength(Note, Length(Note) + 1);
- HighNote := High(Note);
-
- Note[HighNote].Start := StartP;
- if HighNote = 0 then
- begin
- if Lines[LineNumber].Number = 1 then
- Start := -100;
- //Start := Note[HighNote].Start;
- end;
-
- Note[HighNote].Length := DurationP;
-
- // back to the normal system with normal, golden and now freestyle notes
- case TypeP of
- 'F': Note[HighNote].NoteType := ntFreestyle;
- ':': Note[HighNote].NoteType := ntNormal;
- '*': Note[HighNote].NoteType := ntGolden;
- end;
-
- //add this notes value ("notes length" * "notes scorefactor") to the current songs entire value
- Inc(Lines[LineNumber].ScoreValue, Note[HighNote].Length * ScoreFactor[Note[HighNote].NoteType]);
-
- //and to the current lines entire value
- Inc(TotalNotes, Note[HighNote].Length * ScoreFactor[Note[HighNote].NoteType]);
-
-
- Note[HighNote].Tone := NoteP;
-
- //if a note w/ a deeper pitch then the current basenote is found
- //we replace the basenote w/ the current notes pitch
- if Note[HighNote].Tone < BaseNote then
- BaseNote := Note[HighNote].Tone;
-
- Note[HighNote].Color := 1; // default color to 1 for editor
-
- DecodeStringUTF8(LyricS, Note[HighNote].Text, Encoding);
- Lyric := Lyric + Note[HighNote].Text;
-
- End_ := Note[HighNote].Start + Note[HighNote].Length;
- end; // with
-end;
-
-procedure TSong.NewSentence(LineNumberP: integer; Param1, Param2: integer);
-var
- I: integer;
-begin
-
- if (Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote <> -1) then
- begin //create a new line
- SetLength(Lines[LineNumberP].Line, Lines[LineNumberP].Number + 1);
- Inc(Lines[LineNumberP].High);
- Inc(Lines[LineNumberP].Number);
- end
- else
- begin //use old line if it there were no notes added since last call of NewSentence
- Log.LogError('Error loading Song, sentence w/o note found in line ' +
- InttoStr(FileLineNo) + ': ' + Filename.ToNative);
- end;
-
- Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote := -1;
-
- //set the current lines value to zero
- //it will be incremented w/ the value of every added note
- Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := 0;
-
- //basenote is the pitch of the deepest note, it is used for note drawing.
- //if a note with a less value than the current sentences basenote is found,
- //basenote will be set to this notes pitch. Therefore the initial value of
- //this field has to be very high.
- Lines[LineNumberP].Line[Lines[LineNumberP].High].BaseNote := High(Integer);
-
-
- if self.Relative then
- begin
- Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1;
- Rel[LineNumberP] := Rel[LineNumberP] + Param2;
- end
- else
- Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1;
-
- Lines[LineNumberP].Line[Lines[LineNumberP].High].LastLine := false;
-end;
-
-procedure TSong.Clear();
-begin
- //Main Information
- Title := '';
- Artist := '';
-
- //Sortings:
- Genre := 'Unknown';
- Edition := 'Unknown';
- Language := 'Unknown';
- Year := 0;
-
- // set to default encoding
- Encoding := DEFAULT_ENCODING;
-
- // clear custom header tags
- SetLength(CustomTags, 0);
-
- //Required Information
- Mp3 := PATH_NONE;
- SetLength(BPM, 0);
-
- GAP := 0;
- Start := 0;
- Finish := 0;
-
- //Additional Information
- Background := PATH_NONE;
- Cover := PATH_NONE;
- Video := PATH_NONE;
- VideoGAP := 0;
- NotesGAP := 0;
- Resolution := 4;
- Creator := '';
-
- Relative := false;
-end;
-
-function TSong.Analyse(const ReadCustomTags: Boolean): boolean;
-var
- SongFile: TTextFileStream;
-begin
- Result := false;
-
- //Reset LineNo
- FileLineNo := 0;
-
- //Open File and set File Pointer to the beginning
- SongFile := TMemTextFileStream.Create(Self.Path.Append(Self.FileName), fmOpenRead);
- try
- //Clear old Song Header
- Self.clear;
-
- //Read Header
- Result := Self.ReadTxTHeader(SongFile, ReadCustomTags)
- finally
- SongFile.Free;
- end;
-end;
-
-
-function TSong.AnalyseXML(): boolean;
-
-begin
- Result := false;
-
- //Reset LineNo
- FileLineNo := 0;
-
- //Clear old Song Header
- self.clear;
-
- //Read Header
- Result := self.ReadXMLHeader( FileName );
-
-end;
-
-end.
diff --git a/src/base/USongs.pas b/src/base/USongs.pas
deleted file mode 100644
index baeec13a..00000000
--- a/src/base/USongs.pas
+++ /dev/null
@@ -1,845 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit USongs;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-{$IFDEF DARWIN}
- {$IFDEF DEBUG}
- {$DEFINE USE_PSEUDO_THREAD}
- {$ENDIF}
-{$ENDIF}
-
-uses
- SysUtils,
- Classes,
- {$IFDEF MSWINDOWS}
- Windows,
- DirWatch,
- {$ELSE}
- {$IFNDEF DARWIN}
- syscall,
- {$ENDIF}
- baseunix,
- UnixType,
- {$ENDIF}
- UPlatform,
- ULog,
- UTexture,
- UCommon,
- {$IFDEF USE_PSEUDO_THREAD}
- PseudoThread,
- {$ENDIF}
- UPath,
- USong,
- UCatCovers;
-
-type
- TSongFilter = (
- fltAll,
- fltTitle,
- fltArtist
- );
-
- TBPM = record
- BPM: real;
- StartBeat: real;
- end;
-
- TScore = record
- Name: UTF8String;
- Score: integer;
- Length: string;
- end;
-
- TPathDynArray = array of IPath;
-
- {$IFDEF USE_PSEUDO_THREAD}
- TSongs = class(TPseudoThread)
- {$ELSE}
- TSongs = class(TThread)
- {$ENDIF}
- private
- fNotify, fWatch: longint;
- fParseSongDirectory: boolean;
- fProcessing: boolean;
- {$ifdef MSWINDOWS}
- fDirWatch: TDirectoryWatch;
- {$endif}
- procedure int_LoadSongList;
- procedure DoDirChanged(Sender: TObject);
- protected
- procedure Execute; override;
- public
- SongList: TList; // array of songs
- Selected: integer; // selected song index
- constructor Create();
- destructor Destroy(); override;
-
-
- procedure LoadSongList; // load all songs
- procedure FindFilesByExtension(const Dir: IPath; const Ext: IPath; Recursive: Boolean; var Files: TPathDynArray);
- procedure BrowseDir(Dir: IPath); // should return number of songs in the future
- procedure BrowseTXTFiles(Dir: IPath);
- procedure BrowseXMLFiles(Dir: IPath);
- procedure Sort(Order: integer);
- property Processing: boolean read fProcessing;
- end;
-
-
- TCatSongs = class
- Song: array of TSong; // array of categories with songs
- Selected: integer; // selected song index
- Order: integer; // order type (0=title)
- CatNumShow: integer; // Category Number being seen
- CatCount: integer; // Number of Categorys
-
- procedure SortSongs();
- procedure Refresh; // refreshes arrays by recreating them from Songs array
- procedure ShowCategory(Index: integer); // expands all songs in category
- procedure HideCategory(Index: integer); // hides all songs in category
- procedure ClickCategoryButton(Index: integer); // uses ShowCategory and HideCategory when needed
- procedure ShowCategoryList; // Hides all Songs And Show the List of all Categorys
- function FindNextVisible(SearchFrom: integer): integer; // Find Next visible Song
- function VisibleSongs: integer; // returns number of visible songs (for tabs)
- function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible)
-
- function SetFilter(FilterStr: UTF8String; Filter: TSongFilter): cardinal;
- end;
-
-var
- Songs: TSongs; // all songs
- CatSongs: TCatSongs; // categorized songs
-
-const
- IN_ACCESS = $00000001; //* File was accessed */
- IN_MODIFY = $00000002; //* File was modified */
- IN_ATTRIB = $00000004; //* Metadata changed */
- IN_CLOSE_WRITE = $00000008; //* Writtable file was closed */
- IN_CLOSE_NOWRITE = $00000010; //* Unwrittable file closed */
- IN_OPEN = $00000020; //* File was opened */
- IN_MOVED_FROM = $00000040; //* File was moved from X */
- IN_MOVED_TO = $00000080; //* File was moved to Y */
- IN_CREATE = $00000100; //* Subfile was created */
- IN_DELETE = $00000200; //* Subfile was deleted */
- IN_DELETE_SELF = $00000400; //* Self was deleted */
-
-
-implementation
-
-uses
- StrUtils,
- UCovers,
- UFiles,
- UGraphic,
- UMain,
- UIni,
- UPathUtils,
- UNote,
- UFilesystem,
- UUnicodeUtils;
-
-constructor TSongs.Create();
-begin
- // do not start thread BEFORE initialization (suspended = true)
- inherited Create(true);
- Self.FreeOnTerminate := true;
-
- SongList := TList.Create();
-
- // FIXME: threaded loading does not work this way.
- // It will just cause crashes but nothing else at the moment.
-(*
- {$ifdef MSWINDOWS}
- fDirWatch := TDirectoryWatch.create(nil);
- fDirWatch.OnChange := DoDirChanged;
- fDirWatch.Directory := SongPath;
- fDirWatch.WatchSubDirs := true;
- fDirWatch.active := true;
- {$ENDIF}
-
- // now we can start the thread
- Resume();
-*)
-
- // until it is fixed, simply load the song-list
- int_LoadSongList();
-end;
-
-destructor TSongs.Destroy();
-begin
- FreeAndNil(SongList);
- inherited;
-end;
-
-procedure TSongs.DoDirChanged(Sender: TObject);
-begin
- LoadSongList();
-end;
-
-procedure TSongs.Execute();
-var
- fChangeNotify: THandle;
-begin
-{$IFDEF USE_PSEUDO_THREAD}
- int_LoadSongList();
-{$ELSE}
- fParseSongDirectory := true;
-
- while not terminated do
- begin
-
- if fParseSongDirectory then
- begin
- Log.LogStatus('Calling int_LoadSongList', 'TSongs.Execute');
- int_LoadSongList();
- end;
-
- Suspend();
- end;
-{$ENDIF}
-end;
-
-procedure TSongs.int_LoadSongList;
-var
- I: integer;
-begin
- try
- fProcessing := true;
-
- Log.LogStatus('Searching For Songs', 'SongList');
-
- // browse directories
- for I := 0 to SongPaths.Count-1 do
- BrowseDir(SongPaths[I] as IPath);
-
- if assigned(CatSongs) then
- CatSongs.Refresh;
-
- if assigned(CatCovers) then
- CatCovers.Load;
-
- //if assigned(Covers) then
- // Covers.Load;
-
- if assigned(ScreenSong) then
- begin
- ScreenSong.GenerateThumbnails();
- ScreenSong.OnShow; // refresh ScreenSong
- end;
-
- finally
- Log.LogStatus('Search Complete', 'SongList');
-
- fParseSongDirectory := false;
- fProcessing := false;
- end;
-end;
-
-
-procedure TSongs.LoadSongList;
-begin
- fParseSongDirectory := true;
- Resume();
-end;
-
-procedure TSongs.BrowseDir(Dir: IPath);
-begin
- BrowseTXTFiles(Dir);
- BrowseXMLFiles(Dir);
-end;
-
-procedure TSongs.FindFilesByExtension(const Dir: IPath; const Ext: IPath; Recursive: Boolean; var Files: TPathDynArray);
-var
- Iter: IFileIterator;
- FileInfo: TFileInfo;
- FileName: IPath;
-begin
- // search for all files and directories
- Iter := FileSystem.FileFind(Dir.Append('*'), faAnyFile);
- while (Iter.HasNext) do
- begin
- FileInfo := Iter.Next;
- FileName := FileInfo.Name;
- if ((FileInfo.Attr and faDirectory) <> 0) then
- begin
- if Recursive and (not FileName.Equals('.')) and (not FileName.Equals('..')) then
- FindFilesByExtension(Dir.Append(FileName), Ext, true, Files);
- end
- else
- begin
- if (Ext.Equals(FileName.GetExtension(), true)) then
- begin
- SetLength(Files, Length(Files)+1);
- Files[High(Files)] := Dir.Append(FileName);
- end;
- end;
- end;
-end;
-
-procedure TSongs.BrowseTXTFiles(Dir: IPath);
-var
- I: integer;
- Files: TPathDynArray;
- Song: TSong;
- Extension: IPath;
-begin
- SetLength(Files, 0);
- Extension := Path('.txt');
- FindFilesByExtension(Dir, Extension, true, Files);
-
- for I := 0 to High(Files) do
- begin
- Song := TSong.Create(Files[I]);
-
- if Song.Analyse then
- SongList.Add(Song)
- else
- begin
- Log.LogError('AnalyseFile failed for "' + Files[I].ToNative + '".');
- FreeAndNil(Song);
- end;
- end;
-
- SetLength(Files, 0);
-end;
-
-procedure TSongs.BrowseXMLFiles(Dir: IPath);
-var
- I: integer;
- Files: TPathDynArray;
- Song: TSong;
- Extension: IPath;
-begin
- SetLength(Files, 0);
- Extension := Path('.xml');
- FindFilesByExtension(Dir, Extension, true, Files);
-
- for I := 0 to High(Files) do
- begin
- Song := TSong.Create(Files[I]);
-
- if Song.AnalyseXML then
- SongList.Add(Song)
- else
- begin
- Log.LogError('AnalyseFile failed for "' + Files[I].ToNative + '".');
- FreeAndNil(Song);
- end;
- end;
-
- SetLength(Files, 0);
-end;
-
-(*
- * Comparison functions for sorting
- *)
-
-function CompareByEdition(Song1, Song2: Pointer): integer;
-begin
- Result := UTF8CompareText(TSong(Song1).Edition, TSong(Song2).Edition);
-end;
-
-function CompareByGenre(Song1, Song2: Pointer): integer;
-begin
- Result := UTF8CompareText(TSong(Song1).Genre, TSong(Song2).Genre);
-end;
-
-function CompareByTitle(Song1, Song2: Pointer): integer;
-begin
- Result := UTF8CompareText(TSong(Song1).Title, TSong(Song2).Title);
-end;
-
-function CompareByArtist(Song1, Song2: Pointer): integer;
-begin
- Result := UTF8CompareText(TSong(Song1).Artist, TSong(Song2).Artist);
-end;
-
-function CompareByFolder(Song1, Song2: Pointer): integer;
-begin
- Result := UTF8CompareText(TSong(Song1).Folder, TSong(Song2).Folder);
-end;
-
-function CompareByLanguage(Song1, Song2: Pointer): integer;
-begin
- Result := UTF8CompareText(TSong(Song1).Language, TSong(Song2).Language);
-end;
-
-procedure TSongs.Sort(Order: integer);
-var
- CompareFunc: TListSortCompare;
-begin
- // FIXME: what is the difference between artist and artist2, etc.?
- case Order of
- sEdition: // by edition
- CompareFunc := CompareByEdition;
- sGenre: // by genre
- CompareFunc := CompareByGenre;
- sTitle: // by title
- CompareFunc := CompareByTitle;
- sArtist: // by artist
- CompareFunc := CompareByArtist;
- sFolder: // by folder
- CompareFunc := CompareByFolder;
- sArtist2: // by artist2
- CompareFunc := CompareByArtist;
- sLanguage: // by Language
- CompareFunc := CompareByLanguage;
- else
- Log.LogCritical('Unsupported comparison', 'TSongs.Sort');
- Exit; // suppress warning
- end; // case
-
- // Note: Do not use TList.Sort() as it uses QuickSort which is instable.
- // For example, if a list is sorted by title first and
- // by artist afterwards, the songs of an artist will not be sorted by title anymore.
- // The stable MergeSort guarantees to maintain this order.
- MergeSort(SongList, CompareFunc);
-end;
-
-procedure TCatSongs.SortSongs();
-begin
- case Ini.Sorting of
- sEdition: begin
- Songs.Sort(sTitle);
- Songs.Sort(sArtist);
- Songs.Sort(sEdition);
- end;
- sGenre: begin
- Songs.Sort(sTitle);
- Songs.Sort(sArtist);
- Songs.Sort(sGenre);
- end;
- sLanguage: begin
- Songs.Sort(sTitle);
- Songs.Sort(sArtist);
- Songs.Sort(sLanguage);
- end;
- sFolder: begin
- Songs.Sort(sTitle);
- Songs.Sort(sArtist);
- Songs.Sort(sFolder);
- end;
- sTitle: begin
- Songs.Sort(sTitle);
- end;
- sArtist: begin
- Songs.Sort(sTitle);
- Songs.Sort(sArtist);
- end;
- sArtist2: begin
- Songs.Sort(sTitle);
- Songs.Sort(sArtist2);
- end;
- end; // case
-end;
-
-procedure TCatSongs.Refresh;
-var
- SongIndex: integer;
- CurSong: TSong;
- CatIndex: integer; // index of current song in Song
- Letter: UCS4Char; // current letter for sorting using letter
- CurCategory: UTF8String; // current edition for sorting using edition, genre etc.
- Order: integer; // number used for ordernum
- LetterTmp: UCS4Char;
- CatNumber: integer; // Number of Song in Category
-
- procedure AddCategoryButton(const CategoryName: UTF8String);
- var
- PrevCatBtnIndex: integer;
- begin
- Inc(Order);
- CatIndex := Length(Song);
- SetLength(Song, CatIndex+1);
- Song[CatIndex] := TSong.Create();
- Song[CatIndex].Artist := '[' + CategoryName + ']';
- Song[CatIndex].Main := true;
- Song[CatIndex].OrderTyp := 0;
- Song[CatIndex].OrderNum := Order;
- Song[CatIndex].Cover := CatCovers.GetCover(Ini.Sorting, CategoryName);
- Song[CatIndex].Visible := true;
-
- // set number of songs in previous category
- PrevCatBtnIndex := CatIndex - CatNumber - 1;
- if ((PrevCatBtnIndex >= 0) and Song[PrevCatBtnIndex].Main) then
- Song[PrevCatBtnIndex].CatNumber := CatNumber;
-
- CatNumber := 0;
- end;
-
-begin
- CatNumShow := -1;
-
- SortSongs();
-
- CurCategory := '';
- Order := 0;
- CatNumber := 0;
-
- // Note: do NOT set Letter to ' ', otherwise no category-button will be
- // created for songs beginning with ' ' if songs of this category exist.
- // TODO: trim song-properties so ' ' will not occur as first chararcter.
- Letter := 0;
-
- // clear song-list
- for SongIndex := 0 to Songs.SongList.Count - 1 do
- begin
- // free category buttons
- // Note: do NOT delete songs, they are just references to Songs.SongList entries
- CurSong := TSong(Songs.SongList[SongIndex]);
- if (CurSong.Main) then
- CurSong.Free;
- end;
- SetLength(Song, 0);
-
- for SongIndex := 0 to Songs.SongList.Count - 1 do
- begin
- CurSong := TSong(Songs.SongList[SongIndex]);
- // if tabs are on, add section buttons for each new section
- if (Ini.Tabs = 1) then
- begin
- case (Ini.Sorting) of
- sEdition: begin
- if (CompareText(CurCategory, CurSong.Edition) <> 0) then
- begin
- CurCategory := CurSong.Edition;
-
- // add Category Button
- AddCategoryButton(CurCategory);
- end;
- end;
-
- sGenre: begin
- if (CompareText(CurCategory, CurSong.Genre) <> 0) then
- begin
- CurCategory := CurSong.Genre;
- // add Genre Button
- AddCategoryButton(CurCategory);
- end;
- end;
-
- sLanguage: begin
- if (CompareText(CurCategory, CurSong.Language) <> 0) then
- begin
- CurCategory := CurSong.Language;
- // add Language Button
- AddCategoryButton(CurCategory);
- end
- end;
-
- sTitle: begin
- if (Length(CurSong.Title) >= 1) then
- begin
- LetterTmp := UCS4UpperCase(UTF8ToUCS4String(CurSong.Title)[0]);
- { all numbers and some punctuation chars are put into a
- category named '#'
- we can't put the other punctuation chars into this category
- because they are not in order, so there will be two different
- categories named '#' }
- if (LetterTmp in [Ord('!') .. Ord('?')]) then
- LetterTmp := Ord('#')
- else
- LetterTmp := UCS4UpperCase(LetterTmp);
- if (Letter <> LetterTmp) then
- begin
- Letter := LetterTmp;
- // add a letter Category Button
- AddCategoryButton(UCS4ToUTF8String(Letter));
- end;
- end;
- end;
-
- sArtist: begin
- if (Length(CurSong.Artist) >= 1) then
- begin
- LetterTmp := UCS4UpperCase(UTF8ToUCS4String(CurSong.Artist)[0]);
- { all numbers and some punctuation chars are put into a
- category named '#'
- we can't put the other punctuation chars into this category
- because they are not in order, so there will be two different
- categories named '#' }
- if (LetterTmp in [Ord('!') .. Ord('?')]) then
- LetterTmp := Ord('#')
- else
- LetterTmp := UCS4UpperCase(LetterTmp);
-
- if (Letter <> LetterTmp) then
- begin
- Letter := LetterTmp;
- // add a letter Category Button
- AddCategoryButton(UCS4ToUTF8String(Letter));
- end;
- end;
- end;
-
- sFolder: begin
- if (UTF8CompareText(CurCategory, CurSong.Folder) <> 0) then
- begin
- CurCategory := CurSong.Folder;
- // add folder tab
- AddCategoryButton(CurCategory);
- end;
- end;
-
- sArtist2: begin
- { this new sorting puts all songs by the same artist into
- a single category }
- if (UTF8CompareText(CurCategory, CurSong.Artist) <> 0) then
- begin
- CurCategory := CurSong.Artist;
- // add folder tab
- AddCategoryButton(CurCategory);
- end;
- end;
-
- end; // case (Ini.Sorting)
- end; // if (Ini.Tabs = 1)
-
- CatIndex := Length(Song);
- SetLength(Song, CatIndex+1);
-
- Inc(CatNumber); // increase number of songs in category
-
- // copy reference to current song
- Song[CatIndex] := CurSong;
-
- // set song's category info
- CurSong.OrderNum := Order; // assigns category
- CurSong.CatNumber := CatNumber;
-
- if (Ini.Tabs = 0) then
- CurSong.Visible := true
- else if (Ini.Tabs = 1) then
- CurSong.Visible := false;
-{
- if (Ini.Tabs = 1) and (Order = 1) then
- begin
- //open first tab
- CurSong.Visible := true;
- end;
- CurSong.Visible := true;
-}
- end;
-
- // set CatNumber of last category
- if (Ini.TabsAtStartup = 1) and (High(Song) >= 1) then
- begin
- // set number of songs in previous category
- SongIndex := CatIndex - CatNumber;
- if ((SongIndex >= 0) and Song[SongIndex].Main) then
- Song[SongIndex].CatNumber := CatNumber;
- end;
-
- // update number of categories
- CatCount := Order;
-end;
-
-procedure TCatSongs.ShowCategory(Index: integer);
-var
- S: integer; // song
-begin
- CatNumShow := Index;
- for S := 0 to high(CatSongs.Song) do
- begin
-{
- if (CatSongs.Song[S].OrderNum = Index) and (not CatSongs.Song[S].Main) then
- CatSongs.Song[S].Visible := true
- else
- CatSongs.Song[S].Visible := false;
-}
-// KMS: This should be the same, but who knows :-)
- CatSongs.Song[S].Visible := ((CatSongs.Song[S].OrderNum = Index) and (not CatSongs.Song[S].Main));
- end;
-end;
-
-procedure TCatSongs.HideCategory(Index: integer); // hides all songs in category
-var
- S: integer; // song
-begin
- for S := 0 to high(CatSongs.Song) do
- begin
- if not CatSongs.Song[S].Main then
- CatSongs.Song[S].Visible := false // hides all at now
- end;
-end;
-
-procedure TCatSongs.ClickCategoryButton(Index: integer);
-var
- Num: integer;
-begin
- Num := CatSongs.Song[Index].OrderNum;
- if Num <> CatNumShow then
- begin
- ShowCategory(Num);
- end
- else
- begin
- ShowCategoryList;
- end;
-end;
-
-//Hide Categorys when in Category Hack
-procedure TCatSongs.ShowCategoryList;
-var
- S: integer;
-begin
- // Hide All Songs Show All Cats
- for S := 0 to high(CatSongs.Song) do
- CatSongs.Song[S].Visible := CatSongs.Song[S].Main;
- CatSongs.Selected := CatNumShow; //Show last shown Category
- CatNumShow := -1;
-end;
-//Hide Categorys when in Category Hack End
-
-// Wrong song selected when tabs on bug
-function TCatSongs.FindNextVisible(SearchFrom:integer): integer;// Find next Visible Song
-var
- I: integer;
-begin
- Result := -1;
- I := SearchFrom;
- while (Result = -1) do
- begin
- Inc (I);
-
- if (I > High(CatSongs.Song)) then
- I := Low(CatSongs.Song);
- if (I = SearchFrom) then // Make One Round and no song found->quit
- Break;
-
- if (CatSongs.Song[I].Visible) then
- Result := I;
- end;
-end;
-// Wrong song selected when tabs on bug End
-
-(**
- * Returns the number of visible songs.
- *)
-function TCatSongs.VisibleSongs: integer;
-var
- SongIndex: integer;
-begin
- Result := 0;
- for SongIndex := 0 to High(CatSongs.Song) do
- begin
- if (CatSongs.Song[SongIndex].Visible) then
- Inc(Result);
- end;
-end;
-
-(**
- * Returns the index of a song in the subset of all visible songs.
- * If all songs are visible, the result will be equal to the Index parameter.
- *)
-function TCatSongs.VisibleIndex(Index: integer): integer;
-var
- SongIndex: integer;
-begin
- Result := 0;
- for SongIndex := 0 to Index - 1 do
- begin
- if (CatSongs.Song[SongIndex].Visible) then
- Inc(Result);
- end;
-end;
-
-function TCatSongs.SetFilter(FilterStr: UTF8String; Filter: TSongFilter): cardinal;
-var
- I, J: integer;
- TmpString: UTF8String;
- WordArray: array of UTF8String;
-begin
- FilterStr := Trim(FilterStr);
- if (FilterStr <> '') then
- begin
- Result := 0;
-
- // initialize word array
- SetLength(WordArray, 1);
-
- // Copy words to SearchStr
- I := Pos(' ', FilterStr);
- while (I <> 0) do
- begin
- WordArray[High(WordArray)] := Copy(FilterStr, 1, I-1);
- SetLength(WordArray, Length(WordArray) + 1);
-
- FilterStr := TrimLeft(Copy(FilterStr, I+1, Length(FilterStr)-I));
- I := Pos(' ', FilterStr);
- end;
-
- // Copy last word
- WordArray[High(WordArray)] := FilterStr;
-
- for I := 0 to High(Song) do
- begin
- if not Song[i].Main then
- begin
- case Filter of
- fltAll:
- TmpString := Song[I].Artist + ' ' + Song[i].Title + ' ' + Song[i].Folder;
- fltTitle:
- TmpString := Song[I].Title;
- fltArtist:
- TmpString := Song[I].Artist;
- end;
- Song[i].Visible := true;
- // Look for every searched word
- for J := 0 to High(WordArray) do
- begin
- Song[i].Visible := Song[i].Visible and
- UTF8ContainsText(TmpString, WordArray[J])
- end;
- if Song[i].Visible then
- Inc(Result);
- end
- else
- Song[i].Visible := false;
- end;
- CatNumShow := -2;
- end
- else
- begin
- for i := 0 to High(Song) do
- begin
- Song[i].Visible := (Ini.Tabs = 1) = Song[i].Main;
- CatNumShow := -1;
- end;
- Result := 0;
- end;
-end;
-
-// -----------------------------------------------------------------------------
-
-end.
diff --git a/src/base/UTextEncoding.pas b/src/base/UTextEncoding.pas
deleted file mode 100644
index 148cd5d4..00000000
--- a/src/base/UTextEncoding.pas
+++ /dev/null
@@ -1,247 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UTextEncoding;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- SysUtils,
- UUnicodeUtils;
-
-type
- TEncoding = (
- encLocale, // current locale (needs cwstring on linux)
- encUTF8, // UTF-8
- encCP1250, // Windows-1250 Central/Eastern Europe (used by Ultrastar)
- encCP1252, // Windows-1252 Western Europe (used by UltraStar Deluxe < 1.1)
- encAuto // try to match the w3c regex and decode as unicode on match
- // and as fallback if not match
- );
-
-const
- UTF8_BOM: UTF8String = #$EF#$BB#$BF;
-
-{**
- * Decodes Src encoded in SrcEncoding to a UTF-16 or UTF-8 encoded Dst string.
- * Returns true if the conversion was successful.
- *}
-function DecodeString(const Src: RawByteString; out Dst: WideString; SrcEncoding: TEncoding): boolean; overload;
-function DecodeString(const Src: RawByteString; SrcEncoding: TEncoding): WideString; overload;
-function DecodeStringUTF8(const Src: RawByteString; out Dst: UTF8String; SrcEncoding: TEncoding): boolean; overload;
-function DecodeStringUTF8(const Src: RawByteString; SrcEncoding: TEncoding): UTF8String; overload;
-
-{**
- * Encodes the UTF-16 or UTF-8 encoded Src string to Dst using DstEncoding
- * Returns true if the conversion was successful.
- *}
-function EncodeString(const Src: WideString; out Dst: RawByteString; DstEncoding: TEncoding): boolean; overload;
-function EncodeString(const Src: WideString; DstEncoding: TEncoding): RawByteString; overload;
-function EncodeStringUTF8(const Src: UTF8String; out Dst: RawByteString; DstEncoding: TEncoding): boolean; overload;
-function EncodeStringUTF8(const Src: UTF8String; DstEncoding: TEncoding): RawByteString; overload;
-
-{**
- * If Text starts with an UTF-8 BOM, the BOM is removed and true will
- * be returned.
- *}
-function CheckReplaceUTF8BOM(var Text: RawByteString): boolean;
-
-{**
- * Parses an encoding string to its TEncoding equivalent.
- * Surrounding whitespace and dashes ('-') are removed, the upper-cased
- * resulting value is then compared with TEncodingNames.
- * If the encoding was not found, the result is set to the Default encoding.
- *}
-function ParseEncoding(const EncodingStr: AnsiString; Default: TEncoding): TEncoding;
-
-{**
- * Returns the name of an encoding.
- *}
-function EncodingName(Encoding: TEncoding): AnsiString;
-
-implementation
-
-uses
- StrUtils,
- pcre,
- ULog;
-
-type
- IEncoder = interface
- function GetName(): AnsiString;
- function Encode(const InStr: UCS4String; out OutStr: RawByteString): boolean;
- function Decode(const InStr: RawByteString; out OutStr: UCS4String): boolean;
- end;
-
- TEncoder = class(TInterfacedObject, IEncoder)
- public
- function GetName(): AnsiString; virtual; abstract;
- function Encode(const InStr: UCS4String; out OutStr: RawByteString): boolean; virtual; abstract;
- function Decode(const InStr: RawByteString; out OutStr: UCS4String): boolean; virtual; abstract;
- end;
-
- TSingleByteEncoder = class(TEncoder)
- public
- function Encode(const InStr: UCS4String; out OutStr: RawByteString): boolean; override;
- function Decode(const InStr: RawByteString; out OutStr: UCS4String): boolean; override;
- function DecodeChar(InChr: AnsiChar; out OutChr: UCS4Char): boolean; virtual; abstract;
- function EncodeChar(InChr: UCS4Char; out OutChr: AnsiChar): boolean; virtual; abstract;
- end;
-
-const
- ERROR_CHAR = '?';
-
-var
- Encoders: array[TEncoding] of IEncoder;
-
-function TSingleByteEncoder.Encode(const InStr: UCS4String; out OutStr: RawByteString): boolean;
-var
- I: integer;
-begin
- SetLength(OutStr, LengthUCS4(InStr));
- Result := true;
- for I := 1 to Length(OutStr) do
- begin
- if (not EncodeChar(InStr[I-1], OutStr[I])) then
- Result := false;
- end;
-end;
-
-function TSingleByteEncoder.Decode(const InStr: RawByteString; out OutStr: UCS4String): boolean;
-var
- I: integer;
-begin
- SetLength(OutStr, Length(InStr)+1);
- Result := true;
- for I := 1 to Length(InStr) do
- begin
- if (not DecodeChar(InStr[I], OutStr[I-1])) then
- Result := false;
- end;
- OutStr[High(OutStr)] := 0;
-end;
-
-function DecodeString(const Src: RawByteString; out Dst: WideString; SrcEncoding: TEncoding): boolean;
-var
- DstUCS4: UCS4String;
-begin
- Result := Encoders[SrcEncoding].Decode(Src, DstUCS4);
- Dst := UCS4StringToWideString(DstUCS4);
-end;
-
-function DecodeString(const Src: RawByteString; SrcEncoding: TEncoding): WideString;
-begin
- DecodeString(Src, Result, SrcEncoding);
-end;
-
-function DecodeStringUTF8(const Src: RawByteString; out Dst: UTF8String; SrcEncoding: TEncoding): boolean;
-var
- DstUCS4: UCS4String;
-begin
- Result := Encoders[SrcEncoding].Decode(Src, DstUCS4);
- Dst := UCS4ToUTF8String(DstUCS4);
-end;
-
-function DecodeStringUTF8(const Src: RawByteString; SrcEncoding: TEncoding): UTF8String;
-begin
- DecodeStringUTF8(Src, Result, SrcEncoding);
-end;
-
-function EncodeString(const Src: WideString; out Dst: RawByteString; DstEncoding: TEncoding): boolean;
-begin
- Result := Encoders[DstEncoding].Encode(WideStringToUCS4String(Src), Dst);
-end;
-
-function EncodeString(const Src: WideString; DstEncoding: TEncoding): RawByteString;
-begin
- EncodeString(Src, Result, DstEncoding);
-end;
-
-function EncodeStringUTF8(const Src: UTF8String; out Dst: RawByteString; DstEncoding: TEncoding): boolean;
-begin
- Result := Encoders[DstEncoding].Encode(UTF8ToUCS4String(Src), Dst);
-end;
-
-function EncodeStringUTF8(const Src: UTF8String; DstEncoding: TEncoding): RawByteString;
-begin
- EncodeStringUTF8(Src, Result, DstEncoding);
-end;
-
-function CheckReplaceUTF8BOM(var Text: RawByteString): boolean;
-begin
- if AnsiStartsStr(UTF8_BOM, Text) then
- begin
- Text := Copy(Text, Length(UTF8_BOM)+1, Length(Text)-Length(UTF8_BOM));
- Result := true;
- Exit;
- end;
- Result := false;
-end;
-
-function ParseEncoding(const EncodingStr: AnsiString; Default: TEncoding): TEncoding;
-var
- PrepStr: AnsiString; // prepared encoding string
- Encoding: TEncoding;
-begin
- // remove surrounding whitespace, replace dashes, to upper case
- PrepStr := UpperCase(AnsiReplaceStr(Trim(EncodingStr), '-', ''));
- for Encoding := Low(TEncoding) to High(TEncoding) do
- begin
- if (Encoders[Encoding].GetName() = PrepStr) then
- begin
- Result := Encoding;
- Exit;
- end;
- end;
- Result := Default;
-end;
-
-function EncodingName(Encoding: TEncoding): AnsiString;
-begin
- Result := Encoders[Encoding].GetName();
-end;
-
-{$I ..\\encoding\\Locale.inc}
-{$I ..\\encoding\\UTF8.inc}
-{$I ..\\encoding\\CP1250.inc}
-{$I ..\\encoding\\CP1252.inc}
-{$I ..\\encoding\\Auto.inc}
-
-initialization
- Encoders[encLocale] := TEncoderLocale.Create;
- Encoders[encUTF8] := TEncoderUTF8.Create;
- Encoders[encCP1250] := TEncoderCP1250.Create;
- Encoders[encCP1252] := TEncoderCP1252.Create;
-
- // use USDX < 1.1 encoding for backward compatibility (encCP1252)
- Encoders[encAuto] := TEncoderAuto.Create(Encoders[encUTF8], Encoders[encCP1252]);
-
-end.
diff --git a/src/base/UTexture.pas b/src/base/UTexture.pas
deleted file mode 100644
index e477dbb1..00000000
--- a/src/base/UTexture.pas
+++ /dev/null
@@ -1,547 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UTexture;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- gl,
- glu,
- glext,
- Classes,
- SysUtils,
- UCommon,
- UPath,
- SDL,
- SDL_Image;
-
-type
- PTexture = ^TTexture;
- TTexture = record
- TexNum: GLuint;
- X: real;
- Y: real;
- Z: real;
- W: real;
- H: real;
- ScaleW: real; // for dynamic scalling while leaving width constant
- ScaleH: real; // for dynamic scalling while leaving height constant
- Rot: real; // 0 - 2*pi
- Int: real; // intensity
- ColR: real;
- ColG: real;
- ColB: real;
- TexW: real; // percentage of width to use [0..1]
- TexH: real; // percentage of height to use [0..1]
- TexX1: real;
- TexY1: real;
- TexX2: real;
- TexY2: real;
- Alpha: real;
- Name: IPath; // experimental for handling cache images. maybe it's useful for dynamic skins
- end;
-
-type
- TTextureType = (
- TEXTURE_TYPE_PLAIN, // Plain (alpha = 1)
- TEXTURE_TYPE_TRANSPARENT, // Alpha is used
- TEXTURE_TYPE_COLORIZED // Alpha is used; Hue of the HSV color-model will be replaced by a new value
- );
-
-const
- TextureTypeStr: array[TTextureType] of string = (
- 'Plain',
- 'Transparent',
- 'Colorized'
- );
-
-function TextureTypeToStr(TexType: TTextureType): string;
-function ParseTextureType(const TypeStr: string; Default: TTextureType): TTextureType;
-
-procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: TTextureType);
-
-type
- PTextureEntry = ^TTextureEntry;
- TTextureEntry = record
- Name: IPath;
- Typ: TTextureType;
- Color: cardinal;
-
- // we use normal TTexture, it's easier to implement and if needed - we copy ready data
- Texture: TTexture; // Full-size texture
- TextureCache: TTexture; // Thumbnail texture
- end;
-
- TTextureDatabase = class
- private
- Texture: array of TTextureEntry;
- public
- procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: cardinal; Cache: boolean);
- function FindTexture(const Name: IPath; Typ: TTextureType; Color: cardinal): integer;
- end;
-
- TTextureUnit = class
- private
- TextureDatabase: TTextureDatabase;
- public
- Limit: integer;
-
- procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Cache: boolean = false); overload;
- procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: cardinal; Cache: boolean = false); overload;
- function GetTexture(const Name: IPath; Typ: TTextureType; FromCache: boolean = false): TTexture; overload;
- function GetTexture(const Name: IPath; Typ: TTextureType; Col: LongWord; FromCache: boolean = false): TTexture; overload;
- function LoadTexture(FromRegistry: boolean; const Identifier: IPath; Typ: TTextureType; Col: LongWord): TTexture; overload;
- function LoadTexture(const Identifier: IPath; Typ: TTextureType; Col: LongWord): TTexture; overload;
- function LoadTexture(const Identifier: IPath): TTexture; overload;
- function CreateTexture(Data: PChar; const Name: IPath; Width, Height: word; BitsPerPixel: byte): TTexture;
- procedure UnloadTexture(const Name: IPath; Typ: TTextureType; FromCache: boolean); overload;
- procedure UnloadTexture(const Name: IPath; Typ: TTextureType; Col: cardinal; FromCache: boolean); overload;
- //procedure FlushTextureDatabase();
-
- constructor Create;
- destructor Destroy; override;
- end;
-
-var
- Texture: TTextureUnit;
-
-implementation
-
-uses
- DateUtils,
- StrUtils,
- Math,
- ULog,
- UCovers,
- UThemes,
- UImage;
-
-procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: TTextureType);
-var
- TempSurface: PSDL_Surface;
- NeededPixFmt: PSDL_Pixelformat;
-begin
- if (Typ = TEXTURE_TYPE_PLAIN) then
- NeededPixFmt := @PixelFmt_RGB
- else if (Typ = TEXTURE_TYPE_TRANSPARENT) or
- (Typ = TEXTURE_TYPE_COLORIZED) then
- NeededPixFmt := @PixelFmt_RGBA
- else
- NeededPixFmt := @PixelFmt_RGB;
-
- if not PixelformatEquals(TexSurface^.format, NeededPixFmt) then
- begin
- TempSurface := TexSurface;
- TexSurface := SDL_ConvertSurface(TempSurface, NeededPixFmt, SDL_SWSURFACE);
- SDL_FreeSurface(TempSurface);
- end;
-end;
-
-{ TTextureDatabase }
-
-procedure TTextureDatabase.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: cardinal; Cache: boolean);
-var
- TextureIndex: integer;
-begin
- TextureIndex := FindTexture(Tex.Name, Typ, Color);
- if (TextureIndex = -1) then
- begin
- TextureIndex := Length(Texture);
- SetLength(Texture, TextureIndex+1);
-
- Texture[TextureIndex].Name := Tex.Name;
- Texture[TextureIndex].Typ := Typ;
- Texture[TextureIndex].Color := Color;
- end;
-
- if (Cache) then
- Texture[TextureIndex].TextureCache := Tex
- else
- Texture[TextureIndex].Texture := Tex;
-end;
-
-function TTextureDatabase.FindTexture(const Name: IPath; Typ: TTextureType; Color: cardinal): integer;
-var
- TextureIndex: integer;
- CurrentTexture: PTextureEntry;
-begin
- Result := -1;
- for TextureIndex := 0 to High(Texture) do
- begin
- CurrentTexture := @Texture[TextureIndex];
- if (CurrentTexture.Name.Equals(Name)) and
- (CurrentTexture.Typ = Typ) then
- begin
- // colorized textures must match in their color too
- if (CurrentTexture.Typ <> TEXTURE_TYPE_COLORIZED) or
- (CurrentTexture.Color = Color) then
- begin
- Result := TextureIndex;
- Break;
- end;
- end;
- end;
-end;
-
-{ TTextureUnit }
-
-constructor TTextureUnit.Create;
-begin
- inherited Create;
- TextureDatabase := TTextureDatabase.Create;
-end;
-
-destructor TTextureUnit.Destroy;
-begin
- TextureDatabase.Free;
- inherited Destroy;
-end;
-
-procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Cache: boolean);
-begin
- TextureDatabase.AddTexture(Tex, Typ, 0, Cache);
-end;
-
-procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: cardinal; Cache: boolean);
-begin
- TextureDatabase.AddTexture(Tex, Typ, Color, Cache);
-end;
-
-function TTextureUnit.LoadTexture(FromRegistry: boolean; const Identifier: IPath; Typ: TTextureType; Col: LongWord): TTexture;
-begin
- // FIXME: what is the FromRegistry parameter supposed to do?
- Result := LoadTexture(Identifier, Typ, Col);
-end;
-
-function TTextureUnit.LoadTexture(const Identifier: IPath): TTexture;
-begin
- Result := LoadTexture(Identifier, TEXTURE_TYPE_PLAIN, 0);
-end;
-
-function TTextureUnit.LoadTexture(const Identifier: IPath; Typ: TTextureType; Col: LongWord): TTexture;
-var
- TexSurface: PSDL_Surface;
- newWidth, newHeight: integer;
- oldWidth, oldHeight: integer;
- ActTex: GLuint;
-begin
- // zero texture data
- FillChar(Result, SizeOf(Result), 0);
-
- // load texture data into memory
- TexSurface := LoadImage(Identifier);
- if not assigned(TexSurface) then
- begin
- Log.LogError('Could not load texture: "' + Identifier.ToNative +'" with type "'+ TextureTypeToStr(Typ) +'"',
- 'TTextureUnit.LoadTexture');
- Exit;
- end;
-
- // convert pixel format as needed
- AdjustPixelFormat(TexSurface, Typ);
-
- // adjust texture size (scale down, if necessary)
- newWidth := TexSurface.W;
- newHeight := TexSurface.H;
-
- if (newWidth > Limit) then
- newWidth := Limit;
-
- if (newHeight > Limit) then
- newHeight := Limit;
-
- if (TexSurface.W > newWidth) or (TexSurface.H > newHeight) then
- ScaleImage(TexSurface, newWidth, newHeight);
-
- // now we might colorize the whole thing
- if (Typ = TEXTURE_TYPE_COLORIZED) then
- ColorizeImage(TexSurface, Col);
-
- // save actual dimensions of our texture
- oldWidth := newWidth;
- oldHeight := newHeight;
-
- // make texture dimensions be powers of 2
- newWidth := Round(Power(2, Ceil(Log2(newWidth))));
- newHeight := Round(Power(2, Ceil(Log2(newHeight))));
- if (newHeight <> oldHeight) or (newWidth <> oldWidth) then
- FitImage(TexSurface, newWidth, newHeight);
-
- // at this point we have the image in memory...
- // scaled so that dimensions are powers of 2
- // and converted to either RGB or RGBA
-
- // if we got a Texture of Type Plain, Transparent or Colorized,
- // then we're done manipulating it
- // and could now create our openGL texture from it
-
- // prepare OpenGL texture
- glGenTextures(1, @ActTex);
-
- glBindTexture(GL_TEXTURE_2D, ActTex);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
-
- // load data into gl texture
- if (Typ = TEXTURE_TYPE_TRANSPARENT) or
- (Typ = TEXTURE_TYPE_COLORIZED) then
- begin
- {$IFDEF FPC_BIG_ENDIAN}
- glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_INT_8_8_8_8_REV, TexSurface.pixels);
- {$ELSE}
- glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels);
- {$ENDIF}
- end
- else //if Typ = TEXTURE_TYPE_PLAIN then
- begin
- {$IFDEF FPC_BIG_ENDIAN}
- glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_BGR, GL_UNSIGNED_BYTE, TexSurface.pixels);
- {$ELSE}
- glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels);
- {$ENDIF}
- end;
-
- // setup texture struct
- with Result do
- begin
- X := 0;
- Y := 0;
- Z := 0;
- W := oldWidth;
- H := oldHeight;
- ScaleW := 1;
- ScaleH := 1;
- Rot := 0;
- TexNum := ActTex;
- TexW := oldWidth / newWidth;
- TexH := oldHeight / newHeight;
-
- Int := 1;
- ColR := 1;
- ColG := 1;
- ColB := 1;
- Alpha := 1;
-
- // new test - default use whole texure, taking TexW and TexH as const and changing these
- TexX1 := 0;
- TexY1 := 0;
- TexX2 := 1;
- TexY2 := 1;
-
- Name := Identifier;
- end;
-
- SDL_FreeSurface(TexSurface);
-end;
-
-function TTextureUnit.GetTexture(const Name: IPath; Typ: TTextureType; FromCache: boolean): TTexture;
-begin
- Result := GetTexture(Name, Typ, 0, FromCache);
-end;
-
-function TTextureUnit.GetTexture(const Name: IPath; Typ: TTextureType; Col: LongWord; FromCache: boolean): TTexture;
-var
- TextureIndex: integer;
-begin
- if (Name.IsUnset) then
- begin
- // zero texture data
- FillChar(Result, SizeOf(Result), 0);
- Exit;
- end;
-
- if (FromCache) then
- begin
- // use texture
- TextureIndex := TextureDatabase.FindTexture(Name, Typ, Col);
- if (TextureIndex > -1) then
- Result := TextureDatabase.Texture[TextureIndex].TextureCache;
- Exit;
- end;
-
- // find texture entry in database
- TextureIndex := TextureDatabase.FindTexture(Name, Typ, Col);
- if (TextureIndex = -1) then
- begin
- // create texture entry in database
- TextureIndex := Length(TextureDatabase.Texture);
- SetLength(TextureDatabase.Texture, TextureIndex+1);
-
- TextureDatabase.Texture[TextureIndex].Name := Name;
- TextureDatabase.Texture[TextureIndex].Typ := Typ;
- TextureDatabase.Texture[TextureIndex].Color := Col;
-
- // inform database that no textures have been loaded into memory
- TextureDatabase.Texture[TextureIndex].Texture.TexNum := 0;
- TextureDatabase.Texture[TextureIndex].TextureCache.TexNum := 0;
- end;
-
- // load full texture
- if (TextureDatabase.Texture[TextureIndex].Texture.TexNum = 0) then
- TextureDatabase.Texture[TextureIndex].Texture := LoadTexture(false, Name, Typ, Col);
-
- // use texture
- Result := TextureDatabase.Texture[TextureIndex].Texture;
-end;
-
-function TTextureUnit.CreateTexture(Data: PChar; const Name: IPath; Width, Height: word; BitsPerPixel: byte): TTexture;
-var
- //Error: integer;
- ActTex: GLuint;
-begin
- glGenTextures(1, @ActTex); // ActText = new texture number
- glBindTexture(GL_TEXTURE_2D, ActTex);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
-
- {$IFDEF FPC_BIG_ENDIAN}
- glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_BGR, GL_UNSIGNED_BYTE, Data);
- {$ELSE}
- glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, Data);
- {$ENDIF}
-
-{
- if Mipmapping then
- begin
- Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]);
-// FPC_BIG_ENDIAN Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_BGR, GL_UNSIGNED_BYTE, @Data[0]);
- if Error > 0 then
- Log.LogError('gluBuild2DMipmaps() failed', 'TTextureUnit.CreateTexture');
- end;
-}
-
- Result.X := 0;
- Result.Y := 0;
- Result.Z := 0;
- Result.W := 0;
- Result.H := 0;
- Result.ScaleW := 1;
- Result.ScaleH := 1;
- Result.Rot := 0;
- Result.TexNum := ActTex;
- Result.TexW := 1;
- Result.TexH := 1;
-
- Result.Int := 1;
- Result.ColR := 1;
- Result.ColG := 1;
- Result.ColB := 1;
- Result.Alpha := 1;
-
- // new test - default use whole texure, taking TexW and TexH as const and changing these
- Result.TexX1 := 0;
- Result.TexY1 := 0;
- Result.TexX2 := 1;
- Result.TexY2 := 1;
-
- Result.Name := Name;
-end;
-
-procedure TTextureUnit.UnloadTexture(const Name: IPath; Typ: TTextureType; FromCache: boolean);
-begin
- UnloadTexture(Name, Typ, 0, FromCache);
-end;
-
-procedure TTextureUnit.UnloadTexture(const Name: IPath; Typ: TTextureType; Col: cardinal; FromCache: boolean);
-var
- T: integer;
- TexNum: GLuint;
-begin
- T := TextureDatabase.FindTexture(Name, Typ, Col);
-
- if not FromCache then
- begin
- TexNum := TextureDatabase.Texture[T].Texture.TexNum;
- if TexNum > 0 then
- begin
- glDeleteTextures(1, PGLuint(@TexNum));
- TextureDatabase.Texture[T].Texture.TexNum := 0;
- //Log.LogError('Unload texture no '+IntToStr(TexNum));
- end;
- end
- else
- begin
- TexNum := TextureDatabase.Texture[T].TextureCache.TexNum;
- if TexNum > 0 then
- begin
- glDeleteTextures(1, @TexNum);
- TextureDatabase.Texture[T].TextureCache.TexNum := 0;
- //Log.LogError('Unload texture cache no '+IntToStr(TexNum));
- end;
- end;
-end;
-
-(* This needs some work
-procedure TTextureUnit.FlushTextureDatabase();
-var
- i: integer;
- Tex: ^TTexture;
-begin
- for i := 0 to High(TextureDatabase.Texture) do
- begin
- // only delete non-cached entries
- if (TextureDatabase.Texture[i].Texture.TexNum > 0) then
- begin
- Tex := @TextureDatabase.Texture[i].Texture;
- glDeleteTextures(1, PGLuint(Tex^.TexNum));
- Tex^.TexNum := 0;
- end;
- end;
-end;
-*)
-
-function TextureTypeToStr(TexType: TTextureType): string;
-begin
- Result := TextureTypeStr[TexType];
-end;
-
-function ParseTextureType(const TypeStr: string; Default: TTextureType): TTextureType;
-var
- TextureType: TTextureType;
- UpCaseStr: string;
-begin
- UpCaseStr := UpperCase(TypeStr);
- for TextureType := Low(TextureTypeStr) to High(TextureTypeStr) do
- begin
- if (UpCaseStr = UpperCase(TextureTypeStr[TextureType])) then
- begin
- Result := TextureType;
- Exit;
- end;
- end;
- Log.LogWarn('Unknown texture type: "' + TypeStr + '". Using default texture type "' + TextureTypeToStr(Default) + '"', 'ParseTextureType');
- Result := Default;
-end;
-
-end.
diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas
deleted file mode 100644
index 4322815e..00000000
--- a/src/base/UThemes.pas
+++ /dev/null
@@ -1,2397 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UThemes;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- IniFiles,
- SysUtils,
- Classes,
- ULog,
- UTexture,
- UPath;
-
-type
- TRGB = record
- R: single;
- G: single;
- B: single;
- end;
-
- TRGBA = record
- R, G, B, A: double;
- end;
-
-type
- TBackgroundType =
- (bgtNone, bgtColor, bgtTexture, bgtVideo, bgtFade, bgtAuto);
-
-const
- BGT_Names: array [TBackgroundType] of string =
- ('none', 'color', 'texture', 'video', 'fade', 'auto');
-
-type
- TThemeBackground = record
- BGType: TBackgroundType;
- Color: TRGB;
- Tex: string;
- Alpha: real;
- end;
-
-const
- //Defaul Background for Screens w/o Theme e.g. editor
- DEFAULT_BACKGROUND: TThemeBackground = (
- BGType: bgtColor;
- Color: (R:1; G:1; B:1);
- Tex: '';
- Alpha: 1.0
- );
-
-
-type
- TThemeStatic = record
- X: integer;
- Y: integer;
- Z: real;
- W: integer;
- H: integer;
- Color: string;
- ColR: real;
- ColG: real;
- ColB: real;
- Tex: string;
- Typ: TTextureType;
- TexX1: real;
- TexY1: real;
- TexX2: real;
- TexY2: real;
- //Reflection
- Reflection: boolean;
- Reflectionspacing: real;
- end;
- AThemeStatic = array of TThemeStatic;
-
- TThemeText = record
- X: integer;
- Y: integer;
- W: integer;
- Z: real;
- Color: string;
- ColR: real;
- ColG: real;
- ColB: real;
- Font: integer;
- Size: integer;
- Align: integer;
- Text: UTF8String;
- //Reflection
- Reflection: boolean;
- ReflectionSpacing: real;
- end;
- AThemeText = array of TThemeText;
-
- TThemeButton = record
- Text: AThemeText;
- X: integer;
- Y: integer;
- Z: real;
- W: integer;
- H: integer;
- Color: string;
- ColR: real;
- ColG: real;
- ColB: real;
- Int: real;
- DColor: string;
- DColR: real;
- DColG: real;
- DColB: real;
- DInt: real;
- Tex: string;
- Typ: TTextureType;
-
- Visible: boolean;
-
- //Reflection Mod
- Reflection: boolean;
- Reflectionspacing: real;
- //Fade Mod
- SelectH: integer;
- SelectW: integer;
- Fade: boolean;
- FadeText: boolean;
- DeSelectReflectionspacing : real;
- FadeTex: string;
- FadeTexPos: integer;
-
- //Button Collection Mod
- Parent: byte; //Number of the Button Collection this Button is assigned to. IF 0: No Assignement
- end;
-
- //Button Collection Mod
- TThemeButtonCollection = record
- Style: TThemeButton;
- ChildCount: byte; //No of assigned Childs
- FirstChild: byte; //No of Child on whose Interaction Position the Button should be
- end;
-
- AThemeButtonCollection = array of TThemeButtonCollection;
- PAThemeButtonCollection = ^AThemeButtonCollection;
-
- TThemeSelectSlide = record
- Tex: string;
- TexSBG: string;
- X: integer;
- Y: integer;
- W: integer;
- H: integer;
- Z: real;
- SBGW: integer;
-
- TextSize: integer;
-
- showArrows:boolean;
- oneItemOnly:boolean;
-
- Text: UTF8String;
- ColR, ColG, ColB, Int: real;
- DColR, DColG, DColB, DInt: real;
- TColR, TColG, TColB, TInt: real;
- TDColR, TDColG, TDColB, TDInt: real;
- SBGColR, SBGColG, SBGColB, SBGInt: real;
- SBGDColR, SBGDColG, SBGDColB, SBGDInt: real;
- STColR, STColG, STColB, STInt: real;
- STDColR, STDColG, STDColB, STDInt: real;
- SkipX: integer;
- end;
-
- TThemeEqualizer = record
- Visible: boolean;
- Direction: boolean;
- Alpha: real;
- X: integer;
- Y: integer;
- Z: real;
- W: integer;
- H: integer;
- Space: integer;
- Bands: integer;
- Length: integer;
- ColR, ColG, ColB: real;
- Reflection: boolean;
- Reflectionspacing: real;
- end;
-
- PThemeBasic = ^TThemeBasic;
- TThemeBasic = class
- Background: TThemeBackground;
- Text: AThemeText;
- Static: AThemeStatic;
-
- //Button Collection Mod
- ButtonCollection: AThemeButtonCollection;
- end;
-
- TThemeLoading = class(TThemeBasic)
- StaticAnimation: TThemeStatic;
- TextLoading: TThemeText;
- end;
-
- TThemeMain = class(TThemeBasic)
- ButtonSolo: TThemeButton;
- ButtonMulti: TThemeButton;
- ButtonStat: TThemeButton;
- ButtonEditor: TThemeButton;
- ButtonOptions: TThemeButton;
- ButtonExit: TThemeButton;
-
- TextDescription: TThemeText;
- TextDescriptionLong: TThemeText;
- Description: array[0..5] of UTF8String;
- DescriptionLong: array[0..5] of UTF8String;
- end;
-
- TThemeName = class(TThemeBasic)
- ButtonPlayer: array[1..6] of TThemeButton;
- end;
-
- TThemeLevel = class(TThemeBasic)
- ButtonEasy: TThemeButton;
- ButtonMedium: TThemeButton;
- ButtonHard: TThemeButton;
- end;
-
- TThemeSong = class(TThemeBasic)
- TextArtist: TThemeText;
- TextTitle: TThemeText;
- TextNumber: TThemeText;
-
- //Video Icon Mod
- VideoIcon: TThemeStatic;
-
- //Show Cat in TopLeft Mod
- TextCat: TThemeText;
- StaticCat: TThemeStatic;
-
- //Cover Mod
- Cover: record
- Reflections: boolean;
- X: integer;
- Y: integer;
- Z: integer;
- W: integer;
- H: integer;
- Style: integer;
- end;
-
- //Equalizer Mod
- Equalizer: TThemeEqualizer;
-
-
- //Party and Non Party specific Statics and Texts
- StaticParty: AThemeStatic;
- TextParty: AThemeText;
-
- StaticNonParty: AThemeStatic;
- TextNonParty: AThemeText;
-
- //Party Mode
- StaticTeam1Joker1: TThemeStatic;
- StaticTeam1Joker2: TThemeStatic;
- StaticTeam1Joker3: TThemeStatic;
- StaticTeam1Joker4: TThemeStatic;
- StaticTeam1Joker5: TThemeStatic;
- StaticTeam2Joker1: TThemeStatic;
- StaticTeam2Joker2: TThemeStatic;
- StaticTeam2Joker3: TThemeStatic;
- StaticTeam2Joker4: TThemeStatic;
- StaticTeam2Joker5: TThemeStatic;
- StaticTeam3Joker1: TThemeStatic;
- StaticTeam3Joker2: TThemeStatic;
- StaticTeam3Joker3: TThemeStatic;
- StaticTeam3Joker4: TThemeStatic;
- StaticTeam3Joker5: TThemeStatic;
-
-
- end;
-
- TThemeSing = class(TThemeBasic)
-
- //TimeBar mod
- StaticTimeProgress: TThemeStatic;
- TextTimeText : TThemeText;
- //eoa TimeBar mod
-
- StaticP1: TThemeStatic;
- TextP1: TThemeText;
- StaticP1ScoreBG: TThemeStatic; //Static for ScoreBG
- TextP1Score: TThemeText;
-
- //moveable singbar mod
- StaticP1SingBar: TThemeStatic;
- StaticP1ThreePSingBar: TThemeStatic;
- StaticP1TwoPSingBar: TThemeStatic;
- StaticP2RSingBar: TThemeStatic;
- StaticP2MSingBar: TThemeStatic;
- StaticP3SingBar: TThemeStatic;
- //eoa moveable singbar
-
- //added for ps3 skin
- //game in 2/4 player modi
- StaticP1TwoP: TThemeStatic;
- StaticP1TwoPScoreBG: TThemeStatic; //Static for ScoreBG
- TextP1TwoP: TThemeText;
- TextP1TwoPScore: TThemeText;
- //game in 3/6 player modi
- StaticP1ThreeP: TThemeStatic;
- StaticP1ThreePScoreBG: TThemeStatic; //Static for ScoreBG
- TextP1ThreeP: TThemeText;
- TextP1ThreePScore: TThemeText;
- //eoa
-
- StaticP2R: TThemeStatic;
- StaticP2RScoreBG: TThemeStatic; //Static for ScoreBG
- TextP2R: TThemeText;
- TextP2RScore: TThemeText;
-
- StaticP2M: TThemeStatic;
- StaticP2MScoreBG: TThemeStatic; //Static for ScoreBG
- TextP2M: TThemeText;
- TextP2MScore: TThemeText;
-
- StaticP3R: TThemeStatic;
- StaticP3RScoreBG: TThemeStatic; //Static for ScoreBG
- TextP3R: TThemeText;
- TextP3RScore: TThemeText;
-
- //Linebonus Translations
- LineBonusText: array [0..8] of UTF8String;
-
- //Pause Popup
- PausePopUp: TThemeStatic;
- end;
-
- TThemeLyricBar = record
- IndicatorYOffset, UpperX, UpperW, UpperY, UpperH,
- LowerX, LowerW, LowerY, LowerH : integer;
- end;
-
- TThemeScore = class(TThemeBasic)
- TextArtist: TThemeText;
- TextTitle: TThemeText;
-
- TextArtistTitle: TThemeText;
-
- PlayerStatic: array[1..6] of AThemeStatic;
- PlayerTexts: array[1..6] of AThemeText;
-
- TextName: array[1..6] of TThemeText;
- TextScore: array[1..6] of TThemeText;
-
- TextNotes: array[1..6] of TThemeText;
- TextNotesScore: array[1..6] of TThemeText;
- TextLineBonus: array[1..6] of TThemeText;
- TextLineBonusScore: array[1..6] of TThemeText;
- TextGoldenNotes: array[1..6] of TThemeText;
- TextGoldenNotesScore: array[1..6] of TThemeText;
- TextTotal: array[1..6] of TThemeText;
- TextTotalScore: array[1..6] of TThemeText;
-
- StaticBoxLightest: array[1..6] of TThemeStatic;
- StaticBoxLight: array[1..6] of TThemeStatic;
- StaticBoxDark: array[1..6] of TThemeStatic;
-
- StaticRatings: array[1..6] of TThemeStatic;
-
- StaticBackLevel: array[1..6] of TThemeStatic;
- StaticBackLevelRound: array[1..6] of TThemeStatic;
- StaticLevel: array[1..6] of TThemeStatic;
- StaticLevelRound: array[1..6] of TThemeStatic;
-
-// Description: array[0..5] of string;}
- end;
-
- TThemeTop5 = class(TThemeBasic)
- TextLevel: TThemeText;
- TextArtistTitle: TThemeText;
-
- StaticNumber: AThemeStatic;
- TextNumber: AThemeText;
- TextName: AThemeText;
- TextScore: AThemeText;
- TextDate: AThemeText;
- end;
-
- TThemeOptions = class(TThemeBasic)
- ButtonGame: TThemeButton;
- ButtonGraphics: TThemeButton;
- ButtonSound: TThemeButton;
- ButtonLyrics: TThemeButton;
- ButtonThemes: TThemeButton;
- ButtonRecord: TThemeButton;
- ButtonAdvanced: TThemeButton;
- ButtonExit: TThemeButton;
-
- TextDescription: TThemeText;
- Description: array[0..7] of UTF8String;
- end;
-
- TThemeOptionsGame = class(TThemeBasic)
- SelectPlayers: TThemeSelectSlide;
- SelectDifficulty: TThemeSelectSlide;
- SelectLanguage: TThemeSelectSlide;
- SelectTabs: TThemeSelectSlide;
- SelectSorting: TThemeSelectSlide;
- SelectDebug: TThemeSelectSlide;
- ButtonExit: TThemeButton;
- end;
-
- TThemeOptionsGraphics = class(TThemeBasic)
- SelectFullscreen: TThemeSelectSlide;
- SelectResolution: TThemeSelectSlide;
- SelectDepth: TThemeSelectSlide;
- SelectVisualizer: TThemeSelectSlide;
- SelectOscilloscope: TThemeSelectSlide;
- SelectLineBonus: TThemeSelectSlide;
- SelectMovieSize: TThemeSelectSlide;
- ButtonExit: TThemeButton;
- end;
-
- TThemeOptionsSound = class(TThemeBasic)
- SelectMicBoost: TThemeSelectSlide;
- SelectBackgroundMusic: TThemeSelectSlide;
- SelectClickAssist: TThemeSelectSlide;
- SelectBeatClick: TThemeSelectSlide;
- SelectThreshold: TThemeSelectSlide;
- SelectSlidePreviewVolume: TThemeSelectSlide;
- SelectSlidePreviewFading: TThemeSelectSlide;
- SelectSlideVoicePassthrough: TThemeSelectSlide;
- ButtonExit: TThemeButton;
- end;
-
- TThemeOptionsLyrics = class(TThemeBasic)
- SelectLyricsFont: TThemeSelectSlide;
- SelectLyricsEffect: TThemeSelectSlide;
-// SelectSolmization: TThemeSelectSlide;
- SelectNoteLines: TThemeSelectSlide;
- ButtonExit: TThemeButton;
- end;
-
- TThemeOptionsThemes = class(TThemeBasic)
- SelectTheme: TThemeSelectSlide;
- SelectSkin: TThemeSelectSlide;
- SelectColor: TThemeSelectSlide;
- ButtonExit: TThemeButton;
- end;
-
- TThemeOptionsRecord = class(TThemeBasic)
- SelectSlideCard: TThemeSelectSlide;
- SelectSlideInput: TThemeSelectSlide;
- SelectSlideChannel: TThemeSelectSlide;
- ButtonExit: TThemeButton;
- end;
-
- TThemeOptionsAdvanced = class(TThemeBasic)
- SelectLoadAnimation: TThemeSelectSlide;
- SelectEffectSing: TThemeSelectSlide;
- SelectScreenFade: TThemeSelectSlide;
- SelectLineBonus: TThemeSelectSlide;
- SelectAskbeforeDel: TThemeSelectSlide;
- SelectOnSongClick: TThemeSelectSlide;
- SelectPartyPopup: TThemeSelectSlide;
- ButtonExit: TThemeButton;
- end;
-
- TThemeEdit = class(TThemeBasic)
- ButtonConvert: TThemeButton;
- ButtonExit: TThemeButton;
-
- TextDescription: TThemeText;
- TextDescriptionLong: TThemeText;
- Description: array[0..5] of UTF8string;
- DescriptionLong: array[0..5] of UTF8string;
- end;
-
- //Error- and Check-Popup
- TThemeError = class(TThemeBasic)
- Button1: TThemeButton;
- TextError: TThemeText;
- end;
-
- TThemeCheck = class(TThemeBasic)
- Button1: TThemeButton;
- Button2: TThemeButton;
- TextCheck: TThemeText;
- end;
-
-
- //ScreenSong Menue
- TThemeSongMenu = class(TThemeBasic)
- Button1: TThemeButton;
- Button2: TThemeButton;
- Button3: TThemeButton;
- Button4: TThemeButton;
-
- SelectSlide3: TThemeSelectSlide;
-
- TextMenu: TThemeText;
- end;
-
- TThemeSongJumpTo = class(TThemeBasic)
- ButtonSearchText: TThemeButton;
- SelectSlideType: TThemeSelectSlide;
- TextFound: TThemeText;
-
- //Translated Texts
- Songsfound: UTF8String;
- NoSongsfound: UTF8String;
- CatText: UTF8String;
- IType: array [0..2] of UTF8String;
- end;
-
- //Party Screens
- TThemePartyNewRound = class(TThemeBasic)
- TextRound1: TThemeText;
- TextRound2: TThemeText;
- TextRound3: TThemeText;
- TextRound4: TThemeText;
- TextRound5: TThemeText;
- TextRound6: TThemeText;
- TextRound7: TThemeText;
- TextWinner1: TThemeText;
- TextWinner2: TThemeText;
- TextWinner3: TThemeText;
- TextWinner4: TThemeText;
- TextWinner5: TThemeText;
- TextWinner6: TThemeText;
- TextWinner7: TThemeText;
- TextNextRound: TThemeText;
- TextNextRoundNo: TThemeText;
- TextNextPlayer1: TThemeText;
- TextNextPlayer2: TThemeText;
- TextNextPlayer3: TThemeText;
-
- StaticRound1: TThemeStatic;
- StaticRound2: TThemeStatic;
- StaticRound3: TThemeStatic;
- StaticRound4: TThemeStatic;
- StaticRound5: TThemeStatic;
- StaticRound6: TThemeStatic;
- StaticRound7: TThemeStatic;
-
- TextScoreTeam1: TThemeText;
- TextScoreTeam2: TThemeText;
- TextScoreTeam3: TThemeText;
- TextNameTeam1: TThemeText;
- TextNameTeam2: TThemeText;
- TextNameTeam3: TThemeText;
- TextTeam1Players: TThemeText;
- TextTeam2Players: TThemeText;
- TextTeam3Players: TThemeText;
-
- StaticTeam1: TThemeStatic;
- StaticTeam2: TThemeStatic;
- StaticTeam3: TThemeStatic;
- StaticNextPlayer1: TThemeStatic;
- StaticNextPlayer2: TThemeStatic;
- StaticNextPlayer3: TThemeStatic;
- end;
-
- TThemePartyScore = class(TThemeBasic)
- TextScoreTeam1: TThemeText;
- TextScoreTeam2: TThemeText;
- TextScoreTeam3: TThemeText;
- TextNameTeam1: TThemeText;
- TextNameTeam2: TThemeText;
- TextNameTeam3: TThemeText;
- StaticTeam1: TThemeStatic;
- StaticTeam1BG: TThemeStatic;
- StaticTeam1Deco: TThemeStatic;
- StaticTeam2: TThemeStatic;
- StaticTeam2BG: TThemeStatic;
- StaticTeam2Deco: TThemeStatic;
- StaticTeam3: TThemeStatic;
- StaticTeam3BG: TThemeStatic;
- StaticTeam3Deco: TThemeStatic;
-
- DecoTextures: record
- ChangeTextures: boolean;
-
- FirstTexture: string;
- FirstTyp: TTextureType;
- FirstColor: string;
-
- SecondTexture: string;
- SecondTyp: TTextureType;
- SecondColor: string;
-
- ThirdTexture: string;
- ThirdTyp: TTextureType;
- ThirdColor: string;
- end;
-
-
- TextWinner: TThemeText;
- end;
-
- TThemePartyWin = class(TThemeBasic)
- TextScoreTeam1: TThemeText;
- TextScoreTeam2: TThemeText;
- TextScoreTeam3: TThemeText;
- TextNameTeam1: TThemeText;
- TextNameTeam2: TThemeText;
- TextNameTeam3: TThemeText;
- StaticTeam1: TThemeStatic;
- StaticTeam1BG: TThemeStatic;
- StaticTeam1Deco: TThemeStatic;
- StaticTeam2: TThemeStatic;
- StaticTeam2BG: TThemeStatic;
- StaticTeam2Deco: TThemeStatic;
- StaticTeam3: TThemeStatic;
- StaticTeam3BG: TThemeStatic;
- StaticTeam3Deco: TThemeStatic;
-
- TextWinner: TThemeText;
- end;
-
- TThemePartyOptions = class(TThemeBasic)
- SelectLevel: TThemeSelectSlide;
- SelectPlayList: TThemeSelectSlide;
- SelectPlayList2: TThemeSelectSlide;
- SelectRounds: TThemeSelectSlide;
- SelectTeams: TThemeSelectSlide;
- SelectPlayers1: TThemeSelectSlide;
- SelectPlayers2: TThemeSelectSlide;
- SelectPlayers3: TThemeSelectSlide;
-
- {ButtonNext: TThemeButton;
- ButtonPrev: TThemeButton;}
- end;
-
- TThemePartyPlayer = class(TThemeBasic)
- Team1Name: TThemeButton;
- Player1Name: TThemeButton;
- Player2Name: TThemeButton;
- Player3Name: TThemeButton;
- Player4Name: TThemeButton;
-
- Team2Name: TThemeButton;
- Player5Name: TThemeButton;
- Player6Name: TThemeButton;
- Player7Name: TThemeButton;
- Player8Name: TThemeButton;
-
- Team3Name: TThemeButton;
- Player9Name: TThemeButton;
- Player10Name: TThemeButton;
- Player11Name: TThemeButton;
- Player12Name: TThemeButton;
-
- {ButtonNext: TThemeButton;
- ButtonPrev: TThemeButton;}
- end;
-
- //Stats Screens
- TThemeStatMain = class(TThemeBasic)
- ButtonScores: TThemeButton;
- ButtonSingers: TThemeButton;
- ButtonSongs: TThemeButton;
- ButtonBands: TThemeButton;
- ButtonExit: TThemeButton;
-
- TextOverview: TThemeText;
- end;
-
- TThemeStatDetail = class(TThemeBasic)
- ButtonNext: TThemeButton;
- ButtonPrev: TThemeButton;
- ButtonReverse: TThemeButton;
- ButtonExit: TThemeButton;
-
- TextDescription: TThemeText;
- TextPage: TThemeText;
- TextList: AThemeText;
-
- Description: array[0..3] of UTF8String;
- DescriptionR: array[0..3] of UTF8String;
- FormatStr: array[0..3] of UTF8String;
- PageStr: UTF8String;
- end;
-
- //Playlist Translations
- TThemePlaylist = record
- CatText: UTF8String;
- end;
-
- TTheme = class
- private
- {$IFDEF THEMESAVE}
- ThemeIni: TIniFile;
- {$ELSE}
- ThemeIni: TMemIniFile;
- {$ENDIF}
-
- LastThemeBasic: TThemeBasic;
- procedure CreateThemeObjects();
-
- public
- Loading: TThemeLoading;
- Main: TThemeMain;
- Name: TThemeName;
- Level: TThemeLevel;
- Song: TThemeSong;
- Sing: TThemeSing;
- LyricBar: TThemeLyricBar;
- Score: TThemeScore;
- Top5: TThemeTop5;
- Options: TThemeOptions;
- OptionsGame: TThemeOptionsGame;
- OptionsGraphics: TThemeOptionsGraphics;
- OptionsSound: TThemeOptionsSound;
- OptionsLyrics: TThemeOptionsLyrics;
- OptionsThemes: TThemeOptionsThemes;
- OptionsRecord: TThemeOptionsRecord;
- OptionsAdvanced: TThemeOptionsAdvanced;
- //edit
- Edit: TThemeEdit;
- //error and check popup
- ErrorPopup: TThemeError;
- CheckPopup: TThemeCheck;
- //ScreenSong extensions
- SongMenu: TThemeSongMenu;
- SongJumpto: TThemeSongJumpTo;
- //Party Screens:
- PartyNewRound: TThemePartyNewRound;
- PartyScore: TThemePartyScore;
- PartyWin: TThemePartyWin;
- PartyOptions: TThemePartyOptions;
- PartyPlayer: TThemePartyPlayer;
-
- //Stats Screens:
- StatMain: TThemeStatMain;
- StatDetail: TThemeStatDetail;
-
- Playlist: TThemePlaylist;
-
- ILevel: array[0..2] of UTF8String;
-
- constructor Create(const FileName: IPath); overload; // Initialize theme system
- constructor Create(const FileName: IPath; Color: integer); overload; // Initialize theme system with color
- function LoadTheme(const FileName: IPath; sColor: integer): boolean; // Load some theme settings from file
-
- procedure LoadColors;
-
- procedure ThemeLoadBasic(Theme: TThemeBasic; const Name: string);
- procedure ThemeLoadBackground(var ThemeBackground: TThemeBackground; const Name: string);
- procedure ThemeLoadText(var ThemeText: TThemeText; const Name: string);
- procedure ThemeLoadTexts(var ThemeText: AThemeText; const Name: string);
- procedure ThemeLoadStatic(var ThemeStatic: TThemeStatic; const Name: string);
- procedure ThemeLoadStatics(var ThemeStatic: AThemeStatic; const Name: string);
- procedure ThemeLoadButton(var ThemeButton: TThemeButton; const Name: string; Collections: PAThemeButtonCollection = nil);
- procedure ThemeLoadButtonCollection(var Collection: TThemeButtonCollection; const Name: string);
- procedure ThemeLoadButtonCollections(var Collections: AThemeButtonCollection; const Name: string);
- procedure ThemeLoadSelectSlide(var ThemeSelectS: TThemeSelectSlide; const Name: string);
- procedure ThemeLoadEqualizer(var ThemeEqualizer: TThemeEqualizer; const Name: string);
-
- procedure ThemeSave(const FileName: string);
- procedure ThemeSaveBasic(Theme: TThemeBasic; const Name: string);
- procedure ThemeSaveBackground(ThemeBackground: TThemeBackground; const Name: string);
- procedure ThemeSaveStatic(ThemeStatic: TThemeStatic; const Name: string);
- procedure ThemeSaveStatics(ThemeStatic: AThemeStatic; const Name: string);
- procedure ThemeSaveText(ThemeText: TThemeText; const Name: string);
- procedure ThemeSaveTexts(ThemeText: AThemeText; const Name: string);
- procedure ThemeSaveButton(ThemeButton: TThemeButton; const Name: string);
- end;
-
- TColor = record
- Name: string;
- RGB: TRGB;
- end;
-
-procedure glColorRGB(Color: TRGB); overload;
-procedure glColorRGB(Color: TRGB; Alpha: real); overload;
-procedure glColorRGB(Color: TRGBA); overload;
-procedure glColorRGB(Color: TRGBA; Alpha: real); overload;
-
-function ColorExists(Name: string): integer;
-procedure LoadColor(var R, G, B: real; ColorName: string);
-function GetSystemColor(Color: integer): TRGB;
-function ColorSqrt(RGB: TRGB): TRGB;
-
-var
- //Skin: TSkin;
- Theme: TTheme;
- Color: array of TColor;
-
-implementation
-
-uses
- UCommon,
- ULanguage,
- USkins,
- UIni,
- gl,
- glext,
- math;
-
-//-----------
-//Helper procs to use TRGB in Opengl ...maybe this should be somewhere else
-//-----------
-procedure glColorRGB(Color: TRGB); overload;
-begin
- glColor3f(Color.R, Color.G, Color.B);
-end;
-
-procedure glColorRGB(Color: TRGB; Alpha: real); overload;
-begin
- glColor4f(Color.R, Color.G, Color.B, Alpha);
-end;
-
-procedure glColorRGB(Color: TRGBA); overload;
-begin
- glColor4f(Color.R, Color.G, Color.B, Color.A);
-end;
-
-procedure glColorRGB(Color: TRGBA; Alpha: real); overload;
-begin
- glColor4f(Color.R, Color.G, Color.B, Min(Color.A, Alpha));
-end;
-
-constructor TTheme.Create(const FileName: IPath);
-begin
- Create(FileName, 0);
-end;
-
-constructor TTheme.Create(const FileName: IPath; Color: integer);
-begin
- inherited Create();
-
- Loading := TThemeLoading.Create;
- Main := TThemeMain.Create;
- Name := TThemeName.Create;
- Level := TThemeLevel.Create;
- Song := TThemeSong.Create;
- Sing := TThemeSing.Create;
- Score := TThemeScore.Create;
- Top5 := TThemeTop5.Create;
- Options := TThemeOptions.Create;
- OptionsGame := TThemeOptionsGame.Create;
- OptionsGraphics := TThemeOptionsGraphics.Create;
- OptionsSound := TThemeOptionsSound.Create;
- OptionsLyrics := TThemeOptionsLyrics.Create;
- OptionsThemes := TThemeOptionsThemes.Create;
- OptionsRecord := TThemeOptionsRecord.Create;
- OptionsAdvanced := TThemeOptionsAdvanced.Create;
-
- Edit := TThemeEdit.Create;
-
- ErrorPopup := TThemeError.Create;
- CheckPopup := TThemeCheck.Create;
-
- SongMenu := TThemeSongMenu.Create;
- SongJumpto := TThemeSongJumpto.Create;
- //Party Screens
- PartyNewRound := TThemePartyNewRound.Create;
- PartyWin := TThemePartyWin.Create;
- PartyScore := TThemePartyScore.Create;
- PartyOptions := TThemePartyOptions.Create;
- PartyPlayer := TThemePartyPlayer.Create;
-
- //Stats Screens:
- StatMain := TThemeStatMain.Create;
- StatDetail := TThemeStatDetail.Create;
-
- LoadTheme(FileName, Color);
-
-end;
-
-function TTheme.LoadTheme(const FileName: IPath; sColor: integer): boolean;
-var
- I: integer;
-begin
- Result := false;
-
- CreateThemeObjects();
-
- Log.LogStatus('Loading: '+ FileName.ToNative, 'TTheme.LoadTheme');
-
- if not FileName.IsFile() then
- begin
- Log.LogError('Theme does not exist ('+ FileName.ToNative +')', 'TTheme.LoadTheme');
- end;
-
- if FileName.IsFile() then
- begin
- Result := true;
-
- {$IFDEF THEMESAVE}
- ThemeIni := TIniFile.Create(FileName.ToNative);
- {$ELSE}
- ThemeIni := TMemIniFile.Create(FileName.ToNative);
- {$ENDIF}
-
- if ThemeIni.ReadString('Theme', 'Name', '') <> '' then
- begin
-
- {Skin.SkinName := ThemeIni.ReadString('Theme', 'Name', 'Singstar');
- Skin.SkinPath := 'Skins\' + Skin.SkinName + '\';
- Skin.SkinReg := false; }
- Skin.Color := sColor;
-
- Skin.LoadSkin(ISkin[Ini.SkinNo]);
-
- LoadColors;
-
-// ThemeIni.Free;
-// ThemeIni := TIniFile.Create('Themes\Singstar\Main.ini');
-
- // Loading
- ThemeLoadBasic(Loading, 'Loading');
- ThemeLoadText(Loading.TextLoading, 'LoadingTextLoading');
- ThemeLoadStatic(Loading.StaticAnimation, 'LoadingStaticAnimation');
-
- // Main
- ThemeLoadBasic(Main, 'Main');
-
- ThemeLoadText(Main.TextDescription, 'MainTextDescription');
- ThemeLoadText(Main.TextDescriptionLong, 'MainTextDescriptionLong');
- ThemeLoadButton(Main.ButtonSolo, 'MainButtonSolo');
- ThemeLoadButton(Main.ButtonMulti, 'MainButtonMulti');
- ThemeLoadButton(Main.ButtonStat, 'MainButtonStats');
- ThemeLoadButton(Main.ButtonEditor, 'MainButtonEditor');
- ThemeLoadButton(Main.ButtonOptions, 'MainButtonOptions');
- ThemeLoadButton(Main.ButtonExit, 'MainButtonExit');
-
- //Main Desc Text Translation Start
-
- Main.Description[0] := Language.Translate('SING_SING');
- Main.DescriptionLong[0] := Language.Translate('SING_SING_DESC');
- Main.Description[1] := Language.Translate('SING_MULTI');
- Main.DescriptionLong[1] := Language.Translate('SING_MULTI_DESC');
- Main.Description[2] := Language.Translate('SING_STATS');
- Main.DescriptionLong[2] := Language.Translate('SING_STATS_DESC');
- Main.Description[3] := Language.Translate('SING_EDITOR');
- Main.DescriptionLong[3] := Language.Translate('SING_EDITOR_DESC');
- Main.Description[4] := Language.Translate('SING_GAME_OPTIONS');
- Main.DescriptionLong[4] := Language.Translate('SING_GAME_OPTIONS_DESC');
- Main.Description[5] := Language.Translate('SING_EXIT');
- Main.DescriptionLong[5] := Language.Translate('SING_EXIT_DESC');
-
- //Main Desc Text Translation End
-
- Main.TextDescription.Text := Main.Description[0];
- Main.TextDescriptionLong.Text := Main.DescriptionLong[0];
-
- // Name
- ThemeLoadBasic(Name, 'Name');
-
- for I := 1 to 6 do
- ThemeLoadButton(Name.ButtonPlayer[I], 'NameButtonPlayer'+IntToStr(I));
-
- // Level
- ThemeLoadBasic(Level, 'Level');
-
- ThemeLoadButton(Level.ButtonEasy, 'LevelButtonEasy');
- ThemeLoadButton(Level.ButtonMedium, 'LevelButtonMedium');
- ThemeLoadButton(Level.ButtonHard, 'LevelButtonHard');
-
-
- // Song
- ThemeLoadBasic(Song, 'Song');
-
- ThemeLoadText(Song.TextArtist, 'SongTextArtist');
- ThemeLoadText(Song.TextTitle, 'SongTextTitle');
- ThemeLoadText(Song.TextNumber, 'SongTextNumber');
-
- //Video Icon Mod
- ThemeLoadStatic(Song.VideoIcon, 'SongVideoIcon');
-
- //Show Cat in TopLeft Mod
- ThemeLoadStatic(Song.StaticCat, 'SongStaticCat');
- ThemeLoadText(Song.TextCat, 'SongTextCat');
-
- //Load Cover Pos and Size from Theme Mod
- Song.Cover.X := ThemeIni.ReadInteger('SongCover', 'X', 300);
- Song.Cover.Y := ThemeIni.ReadInteger('SongCover', 'Y', 190);
- Song.Cover.W := ThemeIni.ReadInteger('SongCover', 'W', 300);
- Song.Cover.H := ThemeIni.ReadInteger('SongCover', 'H', 200);
- Song.Cover.Style := ThemeIni.ReadInteger('SongCover', 'Style', 4);
- Song.Cover.Reflections := (ThemeIni.ReadInteger('SongCover', 'Reflections', 0) = 1);
- //Load Cover Pos and Size from Theme Mod End
-
- ThemeLoadEqualizer(Song.Equalizer, 'SongEqualizer');
-
- //Party and Non Party specific Statics and Texts
- ThemeLoadStatics (Song.StaticParty, 'SongStaticParty');
- ThemeLoadTexts (Song.TextParty, 'SongTextParty');
-
- ThemeLoadStatics (Song.StaticNonParty, 'SongStaticNonParty');
- ThemeLoadTexts (Song.TextNonParty, 'SongTextNonParty');
-
- //Party Mode
- ThemeLoadStatic(Song.StaticTeam1Joker1, 'SongStaticTeam1Joker1');
- ThemeLoadStatic(Song.StaticTeam1Joker2, 'SongStaticTeam1Joker2');
- ThemeLoadStatic(Song.StaticTeam1Joker3, 'SongStaticTeam1Joker3');
- ThemeLoadStatic(Song.StaticTeam1Joker4, 'SongStaticTeam1Joker4');
- ThemeLoadStatic(Song.StaticTeam1Joker5, 'SongStaticTeam1Joker5');
-
- ThemeLoadStatic(Song.StaticTeam2Joker1, 'SongStaticTeam2Joker1');
- ThemeLoadStatic(Song.StaticTeam2Joker2, 'SongStaticTeam2Joker2');
- ThemeLoadStatic(Song.StaticTeam2Joker3, 'SongStaticTeam2Joker3');
- ThemeLoadStatic(Song.StaticTeam2Joker4, 'SongStaticTeam2Joker4');
- ThemeLoadStatic(Song.StaticTeam2Joker5, 'SongStaticTeam2Joker5');
-
- ThemeLoadStatic(Song.StaticTeam3Joker1, 'SongStaticTeam3Joker1');
- ThemeLoadStatic(Song.StaticTeam3Joker2, 'SongStaticTeam3Joker2');
- ThemeLoadStatic(Song.StaticTeam3Joker3, 'SongStaticTeam3Joker3');
- ThemeLoadStatic(Song.StaticTeam3Joker4, 'SongStaticTeam3Joker4');
- ThemeLoadStatic(Song.StaticTeam3Joker5, 'SongStaticTeam3Joker5');
-
-
- //LyricBar asd
- LyricBar.UpperX := ThemeIni.ReadInteger('SingLyricsUpperBar', 'X', 0);
- LyricBar.UpperW := ThemeIni.ReadInteger('SingLyricsUpperBar', 'W', 0);
- LyricBar.UpperY := ThemeIni.ReadInteger('SingLyricsUpperBar', 'Y', 0);
- LyricBar.UpperH := ThemeIni.ReadInteger('SingLyricsUpperBar', 'H', 0);
- LyricBar.IndicatorYOffset := ThemeIni.ReadInteger('SingLyricsUpperBar', 'IndicatorYOffset', 0);
- LyricBar.LowerX := ThemeIni.ReadInteger('SingLyricsLowerBar', 'X', 0);
- LyricBar.LowerW := ThemeIni.ReadInteger('SingLyricsLowerBar', 'W', 0);
- LyricBar.LowerY := ThemeIni.ReadInteger('SingLyricsLowerBar', 'Y', 0);
- LyricBar.LowerH := ThemeIni.ReadInteger('SingLyricsLowerBar', 'H', 0);
-
- // Sing
- ThemeLoadBasic(Sing, 'Sing');
- //TimeBar mod
- ThemeLoadStatic(Sing.StaticTimeProgress, 'SingTimeProgress');
- ThemeLoadText(Sing.TextTimeText, 'SingTimeText');
- //eoa TimeBar mod
-
- //moveable singbar mod
- ThemeLoadStatic(Sing.StaticP1SingBar, 'SingP1SingBar');
- ThemeLoadStatic(Sing.StaticP1TwoPSingBar, 'SingP1TwoPSingBar');
- ThemeLoadStatic(Sing.StaticP1ThreePSingBar, 'SingP1ThreePSingBar');
- ThemeLoadStatic(Sing.StaticP2RSingBar, 'SingP2RSingBar');
- ThemeLoadStatic(Sing.StaticP2MSingBar, 'SingP2MSingBar');
- ThemeLoadStatic(Sing.StaticP3SingBar, 'SingP3SingBar');
- //eoa moveable singbar
-
- ThemeLoadStatic(Sing.StaticP1, 'SingP1Static');
- ThemeLoadText(Sing.TextP1, 'SingP1Text');
- ThemeLoadStatic(Sing.StaticP1ScoreBG, 'SingP1Static2');
- ThemeLoadText(Sing.TextP1Score, 'SingP1TextScore');
- //Added for ps3 skin
- //This one is shown in 2/4P mode
- //if it exists, otherwise the one Player equivaltents are used
- if (ThemeIni.SectionExists('SingP1TwoPTextScore')) then
- begin
- ThemeLoadStatic(Sing.StaticP1TwoP, 'SingP1TwoPStatic');
- ThemeLoadText(Sing.TextP1TwoP, 'SingP1TwoPText');
- ThemeLoadStatic(Sing.StaticP1TwoPScoreBG, 'SingP1TwoPStatic2');
- ThemeLoadText(Sing.TextP1TwoPScore, 'SingP1TwoPTextScore');
- end
- else
- begin
- Sing.StaticP1TwoP := Sing.StaticP1;
- Sing.TextP1TwoP := Sing.TextP1;
- Sing.StaticP1TwoPScoreBG := Sing.StaticP1ScoreBG;
- Sing.TextP1TwoPScore := Sing.TextP1Score;
- end;
-
- //This one is shown in 3/6P mode
- //if it exists, otherwise the one Player equivaltents are used
- if (ThemeIni.SectionExists('SingP1TwoPTextScore')) then
- begin
- ThemeLoadStatic(Sing.StaticP1ThreeP, 'SingP1ThreePStatic');
- ThemeLoadText(Sing.TextP1ThreeP, 'SingP1ThreePText');
- ThemeLoadStatic(Sing.StaticP1ThreePScoreBG, 'SingP1ThreePStatic2');
- ThemeLoadText(Sing.TextP1ThreePScore, 'SingP1ThreePTextScore');
- end
- else
- begin
- Sing.StaticP1ThreeP := Sing.StaticP1;
- Sing.TextP1ThreeP := Sing.TextP1;
- Sing.StaticP1ThreePScoreBG := Sing.StaticP1ScoreBG;
- Sing.TextP1ThreePScore := Sing.TextP1Score;
- end;
- //eoa
- ThemeLoadStatic(Sing.StaticP2R, 'SingP2RStatic');
- ThemeLoadText(Sing.TextP2R, 'SingP2RText');
- ThemeLoadStatic(Sing.StaticP2RScoreBG, 'SingP2RStatic2');
- ThemeLoadText(Sing.TextP2RScore, 'SingP2RTextScore');
-
- ThemeLoadStatic(Sing.StaticP2M, 'SingP2MStatic');
- ThemeLoadText(Sing.TextP2M, 'SingP2MText');
- ThemeLoadStatic(Sing.StaticP2MScoreBG, 'SingP2MStatic2');
- ThemeLoadText(Sing.TextP2MScore, 'SingP2MTextScore');
-
- ThemeLoadStatic(Sing.StaticP3R, 'SingP3RStatic');
- ThemeLoadText(Sing.TextP3R, 'SingP3RText');
- ThemeLoadStatic(Sing.StaticP3RScoreBG, 'SingP3RStatic2');
- ThemeLoadText(Sing.TextP3RScore, 'SingP3RTextScore');
-
- //Line Bonus Texts
- Sing.LineBonusText[0] := Language.Translate('POPUP_AWFUL');
- Sing.LineBonusText[1] := Sing.LineBonusText[0];
- Sing.LineBonusText[2] := Language.Translate('POPUP_POOR');
- Sing.LineBonusText[3] := Language.Translate('POPUP_BAD');
- Sing.LineBonusText[4] := Language.Translate('POPUP_NOTBAD');
- Sing.LineBonusText[5] := Language.Translate('POPUP_GOOD');
- Sing.LineBonusText[6] := Language.Translate('POPUP_GREAT');
- Sing.LineBonusText[7] := Language.Translate('POPUP_AWESOME');
- Sing.LineBonusText[8] := Language.Translate('POPUP_PERFECT');
-
- //PausePopup
- ThemeLoadStatic(Sing.PausePopUp, 'PausePopUpStatic');
-
- // Score
- ThemeLoadBasic(Score, 'Score');
-
- ThemeLoadText(Score.TextArtist, 'ScoreTextArtist');
- ThemeLoadText(Score.TextTitle, 'ScoreTextTitle');
- ThemeLoadText(Score.TextArtistTitle, 'ScoreTextArtistTitle');
-
- for I := 1 to 6 do
- begin
- ThemeLoadStatics(Score.PlayerStatic[I], 'ScorePlayer' + IntToStr(I) + 'Static');
- ThemeLoadTexts(Score.PlayerTexts[I], 'ScorePlayer' + IntToStr(I) + 'Text');
-
- ThemeLoadText(Score.TextName[I], 'ScoreTextName' + IntToStr(I));
- ThemeLoadText(Score.TextScore[I], 'ScoreTextScore' + IntToStr(I));
- ThemeLoadText(Score.TextNotes[I], 'ScoreTextNotes' + IntToStr(I));
- ThemeLoadText(Score.TextNotesScore[I], 'ScoreTextNotesScore' + IntToStr(I));
- ThemeLoadText(Score.TextLineBonus[I], 'ScoreTextLineBonus' + IntToStr(I));
- ThemeLoadText(Score.TextLineBonusScore[I], 'ScoreTextLineBonusScore' + IntToStr(I));
- ThemeLoadText(Score.TextGoldenNotes[I], 'ScoreTextGoldenNotes' + IntToStr(I));
- ThemeLoadText(Score.TextGoldenNotesScore[I], 'ScoreTextGoldenNotesScore' + IntToStr(I));
- ThemeLoadText(Score.TextTotal[I], 'ScoreTextTotal' + IntToStr(I));
- ThemeLoadText(Score.TextTotalScore[I], 'ScoreTextTotalScore' + IntToStr(I));
-
- ThemeLoadStatic(Score.StaticBoxLightest[I], 'ScoreStaticBoxLightest' + IntToStr(I));
- ThemeLoadStatic(Score.StaticBoxLight[I], 'ScoreStaticBoxLight' + IntToStr(I));
- ThemeLoadStatic(Score.StaticBoxDark[I], 'ScoreStaticBoxDark' + IntToStr(I));
-
- ThemeLoadStatic(Score.StaticBackLevel[I], 'ScoreStaticBackLevel' + IntToStr(I));
- ThemeLoadStatic(Score.StaticBackLevelRound[I], 'ScoreStaticBackLevelRound' + IntToStr(I));
- ThemeLoadStatic(Score.StaticLevel[I], 'ScoreStaticLevel' + IntToStr(I));
- ThemeLoadStatic(Score.StaticLevelRound[I], 'ScoreStaticLevelRound' + IntToStr(I));
-
- ThemeLoadStatic(Score.StaticRatings[I], 'ScoreStaticRatingPicture' + IntToStr(I));
- end;
-
- // Top5
- ThemeLoadBasic(Top5, 'Top5');
-
- ThemeLoadText(Top5.TextLevel, 'Top5TextLevel');
- ThemeLoadText(Top5.TextArtistTitle, 'Top5TextArtistTitle');
- ThemeLoadStatics(Top5.StaticNumber, 'Top5StaticNumber');
- ThemeLoadTexts(Top5.TextNumber, 'Top5TextNumber');
- ThemeLoadTexts(Top5.TextName, 'Top5TextName');
- ThemeLoadTexts(Top5.TextScore, 'Top5TextScore');
- ThemeLoadTexts(Top5.TextDate, 'Top5TextDate');
-
- // Options
- ThemeLoadBasic(Options, 'Options');
-
- ThemeLoadButton(Options.ButtonGame, 'OptionsButtonGame');
- ThemeLoadButton(Options.ButtonGraphics, 'OptionsButtonGraphics');
- ThemeLoadButton(Options.ButtonSound, 'OptionsButtonSound');
- ThemeLoadButton(Options.ButtonLyrics, 'OptionsButtonLyrics');
- ThemeLoadButton(Options.ButtonThemes, 'OptionsButtonThemes');
- ThemeLoadButton(Options.ButtonRecord, 'OptionsButtonRecord');
- ThemeLoadButton(Options.ButtonAdvanced, 'OptionsButtonAdvanced');
- ThemeLoadButton(Options.ButtonExit, 'OptionsButtonExit');
-
- Options.Description[0] := Language.Translate('SING_OPTIONS_GAME_DESC');
- Options.Description[1] := Language.Translate('SING_OPTIONS_GRAPHICS_DESC');
- Options.Description[2] := Language.Translate('SING_OPTIONS_SOUND_DESC');
- Options.Description[3] := Language.Translate('SING_OPTIONS_LYRICS_DESC');
- Options.Description[4] := Language.Translate('SING_OPTIONS_THEMES_DESC');
- Options.Description[5] := Language.Translate('SING_OPTIONS_RECORD_DESC');
- Options.Description[6] := Language.Translate('SING_OPTIONS_ADVANCED_DESC');
- Options.Description[7] := Language.Translate('SING_OPTIONS_EXIT');
-
- ThemeLoadText(Options.TextDescription, 'OptionsTextDescription');
- Options.TextDescription.Text := Options.Description[0];
-
- // Options Game
- ThemeLoadBasic(OptionsGame, 'OptionsGame');
-
- ThemeLoadSelectSlide(OptionsGame.SelectPlayers, 'OptionsGameSelectPlayers');
- ThemeLoadSelectSlide(OptionsGame.SelectDifficulty, 'OptionsGameSelectDifficulty');
- ThemeLoadSelectSlide(OptionsGame.SelectLanguage, 'OptionsGameSelectSlideLanguage');
- ThemeLoadSelectSlide(OptionsGame.SelectTabs, 'OptionsGameSelectTabs');
- ThemeLoadSelectSlide(OptionsGame.SelectSorting, 'OptionsGameSelectSlideSorting');
- ThemeLoadSelectSlide(OptionsGame.SelectDebug, 'OptionsGameSelectDebug');
- ThemeLoadButton(OptionsGame.ButtonExit, 'OptionsGameButtonExit');
-
- // Options Graphics
- ThemeLoadBasic(OptionsGraphics, 'OptionsGraphics');
-
- ThemeLoadSelectSlide(OptionsGraphics.SelectFullscreen, 'OptionsGraphicsSelectFullscreen');
- ThemeLoadSelectSlide(OptionsGraphics.SelectResolution, 'OptionsGraphicsSelectSlideResolution');
- ThemeLoadSelectSlide(OptionsGraphics.SelectDepth, 'OptionsGraphicsSelectDepth');
- ThemeLoadSelectSlide(OptionsGraphics.SelectVisualizer, 'OptionsGraphicsSelectVisualizer');
- ThemeLoadSelectSlide(OptionsGraphics.SelectOscilloscope, 'OptionsGraphicsSelectOscilloscope');
- ThemeLoadSelectSlide(OptionsGraphics.SelectLineBonus, 'OptionsGraphicsSelectLineBonus');
- ThemeLoadSelectSlide(OptionsGraphics.SelectMovieSize, 'OptionsGraphicsSelectMovieSize');
- ThemeLoadButton(OptionsGraphics.ButtonExit, 'OptionsGraphicsButtonExit');
-
- // Options Sound
- ThemeLoadBasic(OptionsSound, 'OptionsSound');
-
- ThemeLoadSelectSlide(OptionsSound.SelectBackgroundMusic, 'OptionsSoundSelectBackgroundMusic');
- ThemeLoadSelectSlide(OptionsSound.SelectMicBoost, 'OptionsSoundSelectMicBoost');
- ThemeLoadSelectSlide(OptionsSound.SelectClickAssist, 'OptionsSoundSelectClickAssist');
- ThemeLoadSelectSlide(OptionsSound.SelectBeatClick, 'OptionsSoundSelectBeatClick');
- ThemeLoadSelectSlide(OptionsSound.SelectThreshold, 'OptionsSoundSelectThreshold');
- //Song Preview
- ThemeLoadSelectSlide(OptionsSound.SelectSlidePreviewVolume, 'OptionsSoundSelectSlidePreviewVolume');
- ThemeLoadSelectSlide(OptionsSound.SelectSlidePreviewFading, 'OptionsSoundSelectSlidePreviewFading');
- ThemeLoadSelectSlide(OptionsSound.SelectSlideVoicePassthrough, 'OptionsSoundSelectVoicePassthrough');
-
- ThemeLoadButton(OptionsSound.ButtonExit, 'OptionsSoundButtonExit');
-
- // Options Lyrics
- ThemeLoadBasic(OptionsLyrics, 'OptionsLyrics');
-
- ThemeLoadSelectSlide(OptionsLyrics.SelectLyricsFont, 'OptionsLyricsSelectLyricsFont');
- ThemeLoadSelectSlide(OptionsLyrics.SelectLyricsEffect, 'OptionsLyricsSelectLyricsEffect');
- //ThemeLoadSelectSlide(OptionsLyrics.SelectSolmization, 'OptionsLyricsSelectSolmization');
- ThemeLoadSelectSlide(OptionsLyrics.SelectNoteLines, 'OptionsLyricsSelectNoteLines');
- ThemeLoadButton(OptionsLyrics.ButtonExit, 'OptionsLyricsButtonExit');
-
- // Options Themes
- ThemeLoadBasic(OptionsThemes, 'OptionsThemes');
-
- ThemeLoadSelectSlide(OptionsThemes.SelectTheme, 'OptionsThemesSelectTheme');
- ThemeLoadSelectSlide(OptionsThemes.SelectSkin, 'OptionsThemesSelectSkin');
- ThemeLoadSelectSlide(OptionsThemes.SelectColor, 'OptionsThemesSelectColor');
- ThemeLoadButton(OptionsThemes.ButtonExit, 'OptionsThemesButtonExit');
-
- // Options Record
- ThemeLoadBasic(OptionsRecord, 'OptionsRecord');
-
- ThemeLoadSelectSlide(OptionsRecord.SelectSlideCard, 'OptionsRecordSelectSlideCard');
- ThemeLoadSelectSlide(OptionsRecord.SelectSlideInput, 'OptionsRecordSelectSlideInput');
- ThemeLoadSelectSlide(OptionsRecord.SelectSlideChannel, 'OptionsRecordSelectSlideChannel');
- ThemeLoadButton(OptionsRecord.ButtonExit, 'OptionsRecordButtonExit');
-
- //Options Advanced
- ThemeLoadBasic(OptionsAdvanced, 'OptionsAdvanced');
-
- ThemeLoadSelectSlide(OptionsAdvanced.SelectLoadAnimation, 'OptionsAdvancedSelectLoadAnimation');
- ThemeLoadSelectSlide(OptionsAdvanced.SelectScreenFade, 'OptionsAdvancedSelectScreenFade');
- ThemeLoadSelectSlide(OptionsAdvanced.SelectEffectSing, 'OptionsAdvancedSelectEffectSing');
- ThemeLoadSelectSlide(OptionsAdvanced.SelectLineBonus, 'OptionsAdvancedSelectLineBonus');
- ThemeLoadSelectSlide(OptionsAdvanced.SelectOnSongClick, 'OptionsAdvancedSelectSlideOnSongClick');
- ThemeLoadSelectSlide(OptionsAdvanced.SelectAskbeforeDel, 'OptionsAdvancedSelectAskbeforeDel');
- ThemeLoadSelectSlide(OptionsAdvanced.SelectPartyPopup, 'OptionsAdvancedSelectPartyPopup');
- ThemeLoadButton (OptionsAdvanced.ButtonExit, 'OptionsAdvancedButtonExit');
-
- //Edit Menu
- ThemeLoadBasic (Edit, 'Edit');
-
- ThemeLoadButton(Edit.ButtonConvert, 'EditButtonConvert');
- ThemeLoadButton(Edit.ButtonExit, 'EditButtonExit');
-
- Edit.Description[0] := Language.Translate('SING_EDIT_BUTTON_DESCRIPTION_CONVERT');
- Edit.Description[1] := Language.Translate('SING_EDIT_BUTTON_DESCRIPTION_EXIT');
-
- ThemeLoadText(Edit.TextDescription, 'EditTextDescription');
- Edit.TextDescription.Text := Edit.Description[0];
-
- //error and check popup
- ThemeLoadBasic (ErrorPopup, 'ErrorPopup');
- ThemeLoadButton(ErrorPopup.Button1, 'ErrorPopupButton1');
- ThemeLoadText (ErrorPopup.TextError,'ErrorPopupText');
- ThemeLoadBasic (CheckPopup, 'CheckPopup');
- ThemeLoadButton(CheckPopup.Button1, 'CheckPopupButton1');
- ThemeLoadButton(CheckPopup.Button2, 'CheckPopupButton2');
- ThemeLoadText(CheckPopup.TextCheck , 'CheckPopupText');
-
- //Song Menu
- ThemeLoadBasic (SongMenu, 'SongMenu');
- ThemeLoadButton(SongMenu.Button1, 'SongMenuButton1');
- ThemeLoadButton(SongMenu.Button2, 'SongMenuButton2');
- ThemeLoadButton(SongMenu.Button3, 'SongMenuButton3');
- ThemeLoadButton(SongMenu.Button4, 'SongMenuButton4');
- ThemeLoadSelectSlide(SongMenu.SelectSlide3, 'SongMenuSelectSlide3');
-
- ThemeLoadText(SongMenu.TextMenu, 'SongMenuTextMenu');
-
- //Song Jumpto
- ThemeLoadBasic (SongJumpto, 'SongJumpto');
- ThemeLoadButton(SongJumpto.ButtonSearchText, 'SongJumptoButtonSearchText');
- ThemeLoadSelectSlide(SongJumpto.SelectSlideType, 'SongJumptoSelectSlideType');
- ThemeLoadText(SongJumpto.TextFound, 'SongJumptoTextFound');
- //Translations
- SongJumpto.IType[0] := Language.Translate('SONG_JUMPTO_TYPE1');
- SongJumpto.IType[1] := Language.Translate('SONG_JUMPTO_TYPE2');
- SongJumpto.IType[2] := Language.Translate('SONG_JUMPTO_TYPE3');
- SongJumpto.SongsFound := Language.Translate('SONG_JUMPTO_SONGSFOUND');
- SongJumpto.NoSongsFound := Language.Translate('SONG_JUMPTO_NOSONGSFOUND');
- SongJumpto.CatText := Language.Translate('SONG_JUMPTO_CATTEXT');
-
- //Party Screens:
- //Party NewRound
- ThemeLoadBasic(PartyNewRound, 'PartyNewRound');
-
- ThemeLoadText (PartyNewRound.TextRound1, 'PartyNewRoundTextRound1');
- ThemeLoadText (PartyNewRound.TextRound2, 'PartyNewRoundTextRound2');
- ThemeLoadText (PartyNewRound.TextRound3, 'PartyNewRoundTextRound3');
- ThemeLoadText (PartyNewRound.TextRound4, 'PartyNewRoundTextRound4');
- ThemeLoadText (PartyNewRound.TextRound5, 'PartyNewRoundTextRound5');
- ThemeLoadText (PartyNewRound.TextRound6, 'PartyNewRoundTextRound6');
- ThemeLoadText (PartyNewRound.TextRound7, 'PartyNewRoundTextRound7');
- ThemeLoadText (PartyNewRound.TextWinner1, 'PartyNewRoundTextWinner1');
- ThemeLoadText (PartyNewRound.TextWinner2, 'PartyNewRoundTextWinner2');
- ThemeLoadText (PartyNewRound.TextWinner3, 'PartyNewRoundTextWinner3');
- ThemeLoadText (PartyNewRound.TextWinner4, 'PartyNewRoundTextWinner4');
- ThemeLoadText (PartyNewRound.TextWinner5, 'PartyNewRoundTextWinner5');
- ThemeLoadText (PartyNewRound.TextWinner6, 'PartyNewRoundTextWinner6');
- ThemeLoadText (PartyNewRound.TextWinner7, 'PartyNewRoundTextWinner7');
- ThemeLoadText (PartyNewRound.TextNextRound, 'PartyNewRoundTextNextRound');
- ThemeLoadText (PartyNewRound.TextNextRoundNo, 'PartyNewRoundTextNextRoundNo');
- ThemeLoadText (PartyNewRound.TextNextPlayer1, 'PartyNewRoundTextNextPlayer1');
- ThemeLoadText (PartyNewRound.TextNextPlayer2, 'PartyNewRoundTextNextPlayer2');
- ThemeLoadText (PartyNewRound.TextNextPlayer3, 'PartyNewRoundTextNextPlayer3');
-
- ThemeLoadStatic (PartyNewRound.StaticRound1, 'PartyNewRoundStaticRound1');
- ThemeLoadStatic (PartyNewRound.StaticRound2, 'PartyNewRoundStaticRound2');
- ThemeLoadStatic (PartyNewRound.StaticRound3, 'PartyNewRoundStaticRound3');
- ThemeLoadStatic (PartyNewRound.StaticRound4, 'PartyNewRoundStaticRound4');
- ThemeLoadStatic (PartyNewRound.StaticRound5, 'PartyNewRoundStaticRound5');
- ThemeLoadStatic (PartyNewRound.StaticRound6, 'PartyNewRoundStaticRound6');
- ThemeLoadStatic (PartyNewRound.StaticRound7, 'PartyNewRoundStaticRound7');
-
- ThemeLoadText (PartyNewRound.TextScoreTeam1, 'PartyNewRoundTextScoreTeam1');
- ThemeLoadText (PartyNewRound.TextScoreTeam2, 'PartyNewRoundTextScoreTeam2');
- ThemeLoadText (PartyNewRound.TextScoreTeam3, 'PartyNewRoundTextScoreTeam3');
- ThemeLoadText (PartyNewRound.TextNameTeam1, 'PartyNewRoundTextNameTeam1');
- ThemeLoadText (PartyNewRound.TextNameTeam2, 'PartyNewRoundTextNameTeam2');
- ThemeLoadText (PartyNewRound.TextNameTeam3, 'PartyNewRoundTextNameTeam3');
-
- ThemeLoadText (PartyNewRound.TextTeam1Players, 'PartyNewRoundTextTeam1Players');
- ThemeLoadText (PartyNewRound.TextTeam2Players, 'PartyNewRoundTextTeam2Players');
- ThemeLoadText (PartyNewRound.TextTeam3Players, 'PartyNewRoundTextTeam3Players');
-
- ThemeLoadStatic (PartyNewRound.StaticTeam1, 'PartyNewRoundStaticTeam1');
- ThemeLoadStatic (PartyNewRound.StaticTeam2, 'PartyNewRoundStaticTeam2');
- ThemeLoadStatic (PartyNewRound.StaticTeam3, 'PartyNewRoundStaticTeam3');
- ThemeLoadStatic (PartyNewRound.StaticNextPlayer1, 'PartyNewRoundStaticNextPlayer1');
- ThemeLoadStatic (PartyNewRound.StaticNextPlayer2, 'PartyNewRoundStaticNextPlayer2');
- ThemeLoadStatic (PartyNewRound.StaticNextPlayer3, 'PartyNewRoundStaticNextPlayer3');
-
- //Party Score
- ThemeLoadBasic(PartyScore, 'PartyScore');
-
- ThemeLoadText (PartyScore.TextScoreTeam1, 'PartyScoreTextScoreTeam1');
- ThemeLoadText (PartyScore.TextScoreTeam2, 'PartyScoreTextScoreTeam2');
- ThemeLoadText (PartyScore.TextScoreTeam3, 'PartyScoreTextScoreTeam3');
- ThemeLoadText (PartyScore.TextNameTeam1, 'PartyScoreTextNameTeam1');
- ThemeLoadText (PartyScore.TextNameTeam2, 'PartyScoreTextNameTeam2');
- ThemeLoadText (PartyScore.TextNameTeam3, 'PartyScoreTextNameTeam3');
-
- ThemeLoadStatic (PartyScore.StaticTeam1, 'PartyScoreStaticTeam1');
- ThemeLoadStatic (PartyScore.StaticTeam1BG, 'PartyScoreStaticTeam1BG');
- ThemeLoadStatic (PartyScore.StaticTeam1Deco, 'PartyScoreStaticTeam1Deco');
- ThemeLoadStatic (PartyScore.StaticTeam2, 'PartyScoreStaticTeam2');
- ThemeLoadStatic (PartyScore.StaticTeam2BG, 'PartyScoreStaticTeam2BG');
- ThemeLoadStatic (PartyScore.StaticTeam2Deco, 'PartyScoreStaticTeam2Deco');
- ThemeLoadStatic (PartyScore.StaticTeam3, 'PartyScoreStaticTeam3');
- ThemeLoadStatic (PartyScore.StaticTeam3BG, 'PartyScoreStaticTeam3BG');
- ThemeLoadStatic (PartyScore.StaticTeam3Deco, 'PartyScoreStaticTeam3Deco');
-
- //Load Party Score DecoTextures Object
- PartyScore.DecoTextures.ChangeTextures := (ThemeIni.ReadInteger('PartyScoreDecoTextures', 'ChangeTextures', 0) = 1);
- PartyScore.DecoTextures.FirstTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstTexture', '');
- PartyScore.DecoTextures.FirstTyp := ParseTextureType(ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstTyp', ''), TEXTURE_TYPE_COLORIZED);
- PartyScore.DecoTextures.FirstColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstColor', 'Black');
-
- PartyScore.DecoTextures.SecondTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTexture', '');
- PartyScore.DecoTextures.SecondTyp := ParseTextureType(ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTyp', ''), TEXTURE_TYPE_COLORIZED);
- PartyScore.DecoTextures.SecondColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondColor', 'Black');
-
- PartyScore.DecoTextures.ThirdTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTexture', '');
- PartyScore.DecoTextures.ThirdTyp := ParseTextureType(ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTyp', ''), TEXTURE_TYPE_COLORIZED);
- PartyScore.DecoTextures.ThirdColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdColor', 'Black');
-
- ThemeLoadText (PartyScore.TextWinner, 'PartyScoreTextWinner');
-
- //Party Win
- ThemeLoadBasic(PartyWin, 'PartyWin');
-
- ThemeLoadText (PartyWin.TextScoreTeam1, 'PartyWinTextScoreTeam1');
- ThemeLoadText (PartyWin.TextScoreTeam2, 'PartyWinTextScoreTeam2');
- ThemeLoadText (PartyWin.TextScoreTeam3, 'PartyWinTextScoreTeam3');
- ThemeLoadText (PartyWin.TextNameTeam1, 'PartyWinTextNameTeam1');
- ThemeLoadText (PartyWin.TextNameTeam2, 'PartyWinTextNameTeam2');
- ThemeLoadText (PartyWin.TextNameTeam3, 'PartyWinTextNameTeam3');
-
- ThemeLoadStatic (PartyWin.StaticTeam1, 'PartyWinStaticTeam1');
- ThemeLoadStatic (PartyWin.StaticTeam1BG, 'PartyWinStaticTeam1BG');
- ThemeLoadStatic (PartyWin.StaticTeam1Deco, 'PartyWinStaticTeam1Deco');
- ThemeLoadStatic (PartyWin.StaticTeam2, 'PartyWinStaticTeam2');
- ThemeLoadStatic (PartyWin.StaticTeam2BG, 'PartyWinStaticTeam2BG');
- ThemeLoadStatic (PartyWin.StaticTeam2Deco, 'PartyWinStaticTeam2Deco');
- ThemeLoadStatic (PartyWin.StaticTeam3, 'PartyWinStaticTeam3');
- ThemeLoadStatic (PartyWin.StaticTeam3BG, 'PartyWinStaticTeam3BG');
- ThemeLoadStatic (PartyWin.StaticTeam3Deco, 'PartyWinStaticTeam3Deco');
-
- ThemeLoadText (PartyWin.TextWinner, 'PartyWinTextWinner');
-
- //Party Options
- ThemeLoadBasic(PartyOptions, 'PartyOptions');
- ThemeLoadSelectSlide(PartyOptions.SelectLevel, 'PartyOptionsSelectLevel');
- ThemeLoadSelectSlide(PartyOptions.SelectPlayList, 'PartyOptionsSelectPlayList');
- ThemeLoadSelectSlide(PartyOptions.SelectPlayList2, 'PartyOptionsSelectPlayList2');
- ThemeLoadSelectSlide(PartyOptions.SelectRounds, 'PartyOptionsSelectRounds');
- ThemeLoadSelectSlide(PartyOptions.SelectTeams, 'PartyOptionsSelectTeams');
- ThemeLoadSelectSlide(PartyOptions.SelectPlayers1, 'PartyOptionsSelectPlayers1');
- ThemeLoadSelectSlide(PartyOptions.SelectPlayers2, 'PartyOptionsSelectPlayers2');
- ThemeLoadSelectSlide(PartyOptions.SelectPlayers3, 'PartyOptionsSelectPlayers3');
-
- {ThemeLoadButton (ButtonNext, 'ButtonNext');
- ThemeLoadButton (ButtonPrev, 'ButtonPrev');}
-
- //Party Player
- ThemeLoadBasic(PartyPlayer, 'PartyPlayer');
- ThemeLoadButton(PartyPlayer.Team1Name, 'PartyPlayerTeam1Name');
- ThemeLoadButton(PartyPlayer.Player1Name, 'PartyPlayerPlayer1Name');
- ThemeLoadButton(PartyPlayer.Player2Name, 'PartyPlayerPlayer2Name');
- ThemeLoadButton(PartyPlayer.Player3Name, 'PartyPlayerPlayer3Name');
- ThemeLoadButton(PartyPlayer.Player4Name, 'PartyPlayerPlayer4Name');
-
- ThemeLoadButton(PartyPlayer.Team2Name, 'PartyPlayerTeam2Name');
- ThemeLoadButton(PartyPlayer.Player5Name, 'PartyPlayerPlayer5Name');
- ThemeLoadButton(PartyPlayer.Player6Name, 'PartyPlayerPlayer6Name');
- ThemeLoadButton(PartyPlayer.Player7Name, 'PartyPlayerPlayer7Name');
- ThemeLoadButton(PartyPlayer.Player8Name, 'PartyPlayerPlayer8Name');
-
- ThemeLoadButton(PartyPlayer.Team3Name, 'PartyPlayerTeam3Name');
- ThemeLoadButton(PartyPlayer.Player9Name, 'PartyPlayerPlayer9Name');
- ThemeLoadButton(PartyPlayer.Player10Name, 'PartyPlayerPlayer10Name');
- ThemeLoadButton(PartyPlayer.Player11Name, 'PartyPlayerPlayer11Name');
- ThemeLoadButton(PartyPlayer.Player12Name, 'PartyPlayerPlayer12Name');
-
- {ThemeLoadButton(ButtonNext, 'PartyPlayerButtonNext');
- ThemeLoadButton(ButtonPrev, 'PartyPlayerButtonPrev');}
-
- ThemeLoadBasic(StatMain, 'StatMain');
-
- ThemeLoadButton(StatMain.ButtonScores, 'StatMainButtonScores');
- ThemeLoadButton(StatMain.ButtonSingers, 'StatMainButtonSingers');
- ThemeLoadButton(StatMain.ButtonSongs, 'StatMainButtonSongs');
- ThemeLoadButton(StatMain.ButtonBands, 'StatMainButtonBands');
- ThemeLoadButton(StatMain.ButtonExit, 'StatMainButtonExit');
-
- ThemeLoadText (StatMain.TextOverview, 'StatMainTextOverview');
-
-
- ThemeLoadBasic(StatDetail, 'StatDetail');
-
- ThemeLoadButton(StatDetail.ButtonNext, 'StatDetailButtonNext');
- ThemeLoadButton(StatDetail.ButtonPrev, 'StatDetailButtonPrev');
- ThemeLoadButton(StatDetail.ButtonReverse, 'StatDetailButtonReverse');
- ThemeLoadButton(StatDetail.ButtonExit, 'StatDetailButtonExit');
-
- ThemeLoadText (StatDetail.TextDescription, 'StatDetailTextDescription');
- ThemeLoadText (StatDetail.TextPage, 'StatDetailTextPage');
- ThemeLoadTexts(StatDetail.TextList, 'StatDetailTextList');
-
- //Translate Texts
- StatDetail.Description[0] := Language.Translate('STAT_DESC_SCORES');
- StatDetail.Description[1] := Language.Translate('STAT_DESC_SINGERS');
- StatDetail.Description[2] := Language.Translate('STAT_DESC_SONGS');
- StatDetail.Description[3] := Language.Translate('STAT_DESC_BANDS');
-
- StatDetail.DescriptionR[0] := Language.Translate('STAT_DESC_SCORES_REVERSED');
- StatDetail.DescriptionR[1] := Language.Translate('STAT_DESC_SINGERS_REVERSED');
- StatDetail.DescriptionR[2] := Language.Translate('STAT_DESC_SONGS_REVERSED');
- StatDetail.DescriptionR[3] := Language.Translate('STAT_DESC_BANDS_REVERSED');
-
- StatDetail.FormatStr[0] := Language.Translate('STAT_FORMAT_SCORES');
- StatDetail.FormatStr[1] := Language.Translate('STAT_FORMAT_SINGERS');
- StatDetail.FormatStr[2] := Language.Translate('STAT_FORMAT_SONGS');
- StatDetail.FormatStr[3] := Language.Translate('STAT_FORMAT_BANDS');
-
- StatDetail.PageStr := Language.Translate('STAT_PAGE');
-
- //Playlist Translations
- Playlist.CatText := Language.Translate('PLAYLIST_CATTEXT');
-
- //Level Translations
- //Fill ILevel
- ILevel[0] := Language.Translate('SING_EASY');
- ILevel[1] := Language.Translate('SING_MEDIUM');
- ILevel[2] := Language.Translate('SING_HARD');
- end;
-
- ThemeIni.Free;
- end;
-end;
-
-procedure TTheme.ThemeLoadBasic(Theme: TThemeBasic; const Name: string);
-begin
- ThemeLoadBackground(Theme.Background, Name);
- ThemeLoadTexts(Theme.Text, Name + 'Text');
- ThemeLoadStatics(Theme.Static, Name + 'Static');
- ThemeLoadButtonCollections(Theme.ButtonCollection, Name + 'ButtonCollection');
-
- LastThemeBasic := Theme;
-end;
-
-procedure TTheme.ThemeLoadBackground(var ThemeBackground: TThemeBackground; const Name: string);
-var
- BGType: string;
- I: TBackgroundType;
-begin
- BGType := LowerCase(ThemeIni.ReadString(Name + 'Background', 'Type', 'auto'));
-
- ThemeBackground.BGType := bgtAuto;
- for I := Low(BGT_Names) to High(BGT_Names) do
- begin
- if (BGT_Names[I] = BGType) then
- begin
- ThemeBackground.BGType := I;
- Break;
- end;
- end;
-
- ThemeBackground.Tex := ThemeIni.ReadString(Name + 'Background', 'Tex', '');
- ThemeBackground.Color.R := ThemeIni.ReadFloat(Name + 'Background', 'ColR', 1);
- ThemeBackground.Color.G := ThemeIni.ReadFloat(Name + 'Background', 'ColG', 1);
- ThemeBackground.Color.B := ThemeIni.ReadFloat(Name + 'Background', 'ColB', 1);
- ThemeBackground.Alpha := ThemeIni.ReadFloat(Name + 'Background', 'Alpha', 1);
-end;
-
-procedure TTheme.ThemeLoadText(var ThemeText: TThemeText; const Name: string);
-var
- C: integer;
-begin
- ThemeText.X := ThemeIni.ReadInteger(Name, 'X', 0);
- ThemeText.Y := ThemeIni.ReadInteger(Name, 'Y', 0);
- ThemeText.W := ThemeIni.ReadInteger(Name, 'W', 0);
-
- ThemeText.Z := ThemeIni.ReadFloat(Name, 'Z', 0);
-
- ThemeText.ColR := ThemeIni.ReadFloat(Name, 'ColR', 0);
- ThemeText.ColG := ThemeIni.ReadFloat(Name, 'ColG', 0);
- ThemeText.ColB := ThemeIni.ReadFloat(Name, 'ColB', 0);
-
- ThemeText.Font := ThemeIni.ReadInteger(Name, 'Font', 0);
- ThemeText.Size := ThemeIni.ReadInteger(Name, 'Size', 0);
- ThemeText.Align := ThemeIni.ReadInteger(Name, 'Align', 0);
-
- ThemeText.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', ''));
- ThemeText.Color := ThemeIni.ReadString(Name, 'Color', '');
-
- //Reflection
- ThemeText.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0)) = 1;
- ThemeText.Reflectionspacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15);
-
- C := ColorExists(ThemeText.Color);
- if C >= 0 then
- begin
- ThemeText.ColR := Color[C].RGB.R;
- ThemeText.ColG := Color[C].RGB.G;
- ThemeText.ColB := Color[C].RGB.B;
- end;
-end;
-
-procedure TTheme.ThemeLoadTexts(var ThemeText: AThemeText; const Name: string);
-var
- T: integer;
-begin
- T := 1;
- while ThemeIni.SectionExists(Name + IntToStr(T)) do
- begin
- SetLength(ThemeText, T);
- ThemeLoadText(ThemeText[T-1], Name + IntToStr(T));
- Inc(T);
- end;
-end;
-
-procedure TTheme.ThemeLoadStatic(var ThemeStatic: TThemeStatic; const Name: string);
-var
- C: integer;
-begin
- ThemeStatic.Tex := ThemeIni.ReadString(Name, 'Tex', '');
-
- ThemeStatic.X := ThemeIni.ReadInteger(Name, 'X', 0);
- ThemeStatic.Y := ThemeIni.ReadInteger(Name, 'Y', 0);
- ThemeStatic.Z := ThemeIni.ReadFloat (Name, 'Z', 0);
- ThemeStatic.W := ThemeIni.ReadInteger(Name, 'W', 0);
- ThemeStatic.H := ThemeIni.ReadInteger(Name, 'H', 0);
-
- ThemeStatic.Typ := ParseTextureType(ThemeIni.ReadString(Name, 'Type', ''), TEXTURE_TYPE_PLAIN);
- ThemeStatic.Color := ThemeIni.ReadString(Name, 'Color', '');
-
- C := ColorExists(ThemeStatic.Color);
- if C >= 0 then
- begin
- ThemeStatic.ColR := Color[C].RGB.R;
- ThemeStatic.ColG := Color[C].RGB.G;
- ThemeStatic.ColB := Color[C].RGB.B;
- end;
-
- ThemeStatic.TexX1 := ThemeIni.ReadFloat(Name, 'TexX1', 0);
- ThemeStatic.TexY1 := ThemeIni.ReadFloat(Name, 'TexY1', 0);
- ThemeStatic.TexX2 := ThemeIni.ReadFloat(Name, 'TexX2', 1);
- ThemeStatic.TexY2 := ThemeIni.ReadFloat(Name, 'TexY2', 1);
-
- //Reflection Mod
- ThemeStatic.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0) = 1);
- ThemeStatic.ReflectionSpacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15);
-end;
-
-procedure TTheme.ThemeLoadStatics(var ThemeStatic: AThemeStatic; const Name: string);
-var
- S: integer;
-begin
- S := 1;
- while ThemeIni.SectionExists(Name + IntToStr(S)) do
- begin
- SetLength(ThemeStatic, S);
- ThemeLoadStatic(ThemeStatic[S-1], Name + IntToStr(S));
- Inc(S);
- end;
-end;
-
-//Button Collection Mod
-procedure TTheme.ThemeLoadButtonCollection(var Collection: TThemeButtonCollection; const Name: string);
-var T: integer;
-begin
- //Load Collection Style
- ThemeLoadButton(Collection.Style, Name);
-
- //Load Other Attributes
- T := ThemeIni.ReadInteger (Name, 'FirstChild', 0);
- if (T > 0) And (T < 256) then
- Collection.FirstChild := T
- else
- Collection.FirstChild := 0;
-end;
-
-procedure TTheme.ThemeLoadButtonCollections(var Collections: AThemeButtonCollection; const Name: string);
-var
- I: integer;
-begin
- I := 1;
- while ThemeIni.SectionExists(Name + IntToStr(I)) do
- begin
- SetLength(Collections, I);
- ThemeLoadButtonCollection(Collections[I-1], Name + IntToStr(I));
- Inc(I);
- end;
-end;
-//End Button Collection Mod
-
-procedure TTheme.ThemeLoadButton(var ThemeButton: TThemeButton; const Name: string; Collections: PAThemeButtonCollection);
-var
- C: integer;
- TLen: integer;
- T: integer;
- Collections2: PAThemeButtonCollection;
-begin
- if not ThemeIni.SectionExists(Name) then
- begin
- ThemeButton.Visible := False;
- exit;
- end;
- ThemeButton.Tex := ThemeIni.ReadString(Name, 'Tex', '');
- ThemeButton.X := ThemeIni.ReadInteger (Name, 'X', 0);
- ThemeButton.Y := ThemeIni.ReadInteger (Name, 'Y', 0);
- ThemeButton.Z := ThemeIni.ReadFloat (Name, 'Z', 0);
- ThemeButton.W := ThemeIni.ReadInteger (Name, 'W', 0);
- ThemeButton.H := ThemeIni.ReadInteger (Name, 'H', 0);
- ThemeButton.Typ := ParseTextureType(ThemeIni.ReadString(Name, 'Type', ''), TEXTURE_TYPE_PLAIN);
-
- //Reflection Mod
- ThemeButton.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0) = 1);
- ThemeButton.ReflectionSpacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15);
-
- ThemeButton.ColR := ThemeIni.ReadFloat(Name, 'ColR', 1);
- ThemeButton.ColG := ThemeIni.ReadFloat(Name, 'ColG', 1);
- ThemeButton.ColB := ThemeIni.ReadFloat(Name, 'ColB', 1);
- ThemeButton.Int := ThemeIni.ReadFloat(Name, 'Int', 1);
- ThemeButton.DColR := ThemeIni.ReadFloat(Name, 'DColR', 1);
- ThemeButton.DColG := ThemeIni.ReadFloat(Name, 'DColG', 1);
- ThemeButton.DColB := ThemeIni.ReadFloat(Name, 'DColB', 1);
- ThemeButton.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1);
-
- ThemeButton.Color := ThemeIni.ReadString(Name, 'Color', '');
- C := ColorExists(ThemeButton.Color);
- if C >= 0 then
- begin
- ThemeButton.ColR := Color[C].RGB.R;
- ThemeButton.ColG := Color[C].RGB.G;
- ThemeButton.ColB := Color[C].RGB.B;
- end;
-
- ThemeButton.DColor := ThemeIni.ReadString(Name, 'DColor', '');
- C := ColorExists(ThemeButton.DColor);
- if C >= 0 then
- begin
- ThemeButton.DColR := Color[C].RGB.R;
- ThemeButton.DColG := Color[C].RGB.G;
- ThemeButton.DColB := Color[C].RGB.B;
- end;
-
- ThemeButton.Visible := (ThemeIni.ReadInteger(Name, 'Visible', 1) = 1);
-
- //Fade Mod
- ThemeButton.SelectH := ThemeIni.ReadInteger (Name, 'SelectH', ThemeButton.H);
- ThemeButton.SelectW := ThemeIni.ReadInteger (Name, 'SelectW', ThemeButton.W);
-
- ThemeButton.DeSelectReflectionspacing := ThemeIni.ReadFloat(Name, 'DeSelectReflectionSpacing', ThemeButton.Reflectionspacing);
-
- ThemeButton.Fade := (ThemeIni.ReadInteger(Name, 'Fade', 0) = 1);
- ThemeButton.FadeText := (ThemeIni.ReadInteger(Name, 'FadeText', 0) = 1);
-
-
- ThemeButton.FadeTex := ThemeIni.ReadString(Name, 'FadeTex', '');
- ThemeButton.FadeTexPos:= ThemeIni.ReadInteger(Name, 'FadeTexPos', 0);
- if (ThemeButton.FadeTexPos > 4) Or (ThemeButton.FadeTexPos < 0) then
- ThemeButton.FadeTexPos := 0;
-
- //Button Collection Mod
- T := ThemeIni.ReadInteger(Name, 'Parent', 0);
-
- //Set Collections to Last Basic Collections if no valid Value
- if (Collections = nil) then
- Collections2 := @LastThemeBasic.ButtonCollection
- else
- Collections2 := Collections;
- //Test for valid Value
- if (Collections2 <> nil) AND (T > 0) AND (T <= Length(Collections2^)) then
- begin
- Inc(Collections2^[T-1].ChildCount);
- ThemeButton.Parent := T;
- end
- else
- ThemeButton.Parent := 0;
-
- //Read ButtonTexts
- TLen := ThemeIni.ReadInteger(Name, 'Texts', 0);
- SetLength(ThemeButton.Text, TLen);
- for T := 1 to TLen do
- ThemeLoadText(ThemeButton.Text[T-1], Name + 'Text' + IntToStr(T));
-end;
-
-procedure TTheme.ThemeLoadSelectSlide(var ThemeSelectS: TThemeSelectSlide; const Name: string);
-begin
- ThemeSelectS.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', ''));
-
- ThemeSelectS.Tex := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'Tex', '');
- ThemeSelectS.TexSBG := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'TexSBG', '');
-
- ThemeSelectS.X := ThemeIni.ReadInteger(Name, 'X', 0);
- ThemeSelectS.Y := ThemeIni.ReadInteger(Name, 'Y', 0);
- ThemeSelectS.W := ThemeIni.ReadInteger(Name, 'W', 0);
- ThemeSelectS.H := ThemeIni.ReadInteger(Name, 'H', 0);
-
- ThemeSelectS.Z := ThemeIni.ReadFloat(Name, 'Z', 0);
-
- ThemeSelectS.TextSize := ThemeIni.ReadInteger(Name, 'TextSize', 30);
-
- ThemeSelectS.SkipX := ThemeIni.ReadInteger(Name, 'SkipX', 0);
-
- ThemeSelectS.SBGW := ThemeIni.ReadInteger(Name, 'SBGW', 400);
-
- LoadColor(ThemeSelectS.ColR, ThemeSelectS.ColG, ThemeSelectS.ColB, ThemeIni.ReadString(Name, 'Color', ''));
- ThemeSelectS.Int := ThemeIni.ReadFloat(Name, 'Int', 1);
- LoadColor(ThemeSelectS.DColR, ThemeSelectS.DColG, ThemeSelectS.DColB, ThemeIni.ReadString(Name, 'DColor', ''));
- ThemeSelectS.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1);
-
- LoadColor(ThemeSelectS.TColR, ThemeSelectS.TColG, ThemeSelectS.TColB, ThemeIni.ReadString(Name, 'TColor', ''));
- ThemeSelectS.TInt := ThemeIni.ReadFloat(Name, 'TInt', 1);
- LoadColor(ThemeSelectS.TDColR, ThemeSelectS.TDColG, ThemeSelectS.TDColB, ThemeIni.ReadString(Name, 'TDColor', ''));
- ThemeSelectS.TDInt := ThemeIni.ReadFloat(Name, 'TDInt', 1);
-
- LoadColor(ThemeSelectS.SBGColR, ThemeSelectS.SBGColG, ThemeSelectS.SBGColB, ThemeIni.ReadString(Name, 'SBGColor', ''));
- ThemeSelectS.SBGInt := ThemeIni.ReadFloat(Name, 'SBGInt', 1);
- LoadColor(ThemeSelectS.SBGDColR, ThemeSelectS.SBGDColG, ThemeSelectS.SBGDColB, ThemeIni.ReadString(Name, 'SBGDColor', ''));
- ThemeSelectS.SBGDInt := ThemeIni.ReadFloat(Name, 'SBGDInt', 1);
-
- LoadColor(ThemeSelectS.STColR, ThemeSelectS.STColG, ThemeSelectS.STColB, ThemeIni.ReadString(Name, 'STColor', ''));
- ThemeSelectS.STInt := ThemeIni.ReadFloat(Name, 'STInt', 1);
- LoadColor(ThemeSelectS.STDColR, ThemeSelectS.STDColG, ThemeSelectS.STDColB, ThemeIni.ReadString(Name, 'STDColor', ''));
- ThemeSelectS.STDInt := ThemeIni.ReadFloat(Name, 'STDInt', 1);
-end;
-
-procedure TTheme.ThemeLoadEqualizer(var ThemeEqualizer: TThemeEqualizer; const Name: string);
-var I: integer;
-begin
- ThemeEqualizer.Visible := (ThemeIni.ReadInteger(Name, 'Visible', 0) = 1);
- ThemeEqualizer.Direction := (ThemeIni.ReadInteger(Name, 'Direction', 0) = 1);
- ThemeEqualizer.Alpha := ThemeIni.ReadInteger(Name, 'Alpha', 1);
- ThemeEqualizer.Space := ThemeIni.ReadInteger(Name, 'Space', 1);
- ThemeEqualizer.X := ThemeIni.ReadInteger(Name, 'X', 0);
- ThemeEqualizer.Y := ThemeIni.ReadInteger(Name, 'Y', 0);
- ThemeEqualizer.Z := ThemeIni.ReadInteger(Name, 'Z', 1);
- ThemeEqualizer.W := ThemeIni.ReadInteger(Name, 'PieceW', 8);
- ThemeEqualizer.H := ThemeIni.ReadInteger(Name, 'PieceH', 8);
- ThemeEqualizer.Bands := ThemeIni.ReadInteger(Name, 'Bands', 5);
- ThemeEqualizer.Length := ThemeIni.ReadInteger(Name, 'Length', 12);
- ThemeEqualizer.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0) = 1);
- ThemeEqualizer.ReflectionSpacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15);
-
- //Color
- I := ColorExists(ThemeIni.ReadString(Name, 'Color', 'Black'));
- if I >= 0 then
- begin
- ThemeEqualizer.ColR := Color[I].RGB.R;
- ThemeEqualizer.ColG := Color[I].RGB.G;
- ThemeEqualizer.ColB := Color[I].RGB.B;
- end
- else
- begin
- ThemeEqualizer.ColR := 0;
- ThemeEqualizer.ColG := 0;
- ThemeEqualizer.ColB := 0;
- end;
-end;
-
-procedure TTheme.LoadColors;
-var
- SL: TStringList;
- C: integer;
- S: string;
-begin
- SL := TStringList.Create;
- ThemeIni.ReadSection('Colors', SL);
-
- // normal colors
- SetLength(Color, SL.Count);
- for C := 0 to SL.Count-1 do
- begin
- Color[C].Name := SL.Strings[C];
-
- S := ThemeIni.ReadString('Colors', SL.Strings[C], '');
-
- Color[C].RGB.R := StrToInt(Copy(S, 1, Pos(' ' , S)-1))/255;
- Delete(S, 1, Pos(' ', S));
-
- Color[C].RGB.G := StrToInt(Copy(S, 1, Pos(' ' , S)-1))/255;
- Delete(S, 1, Pos(' ', S));
-
- Color[C].RGB.B := StrToInt(S)/255;
- end;
-
- // skin color
- SetLength(Color, SL.Count + 3);
- C := SL.Count;
- Color[C].Name := 'ColorDark';
- Color[C].RGB := GetSystemColor(Skin.Color); //Ini.Color);
-
- C := C+1;
- Color[C].Name := 'ColorLight';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- C := C+1;
- Color[C].Name := 'ColorLightest';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- // players colors
- SetLength(Color, Length(Color)+18);
-
- // P1
- C := C+1;
- Color[C].Name := 'P1Dark';
- Color[C].RGB := GetSystemColor(0); // 0 - blue
-
- C := C+1;
- Color[C].Name := 'P1Light';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- C := C+1;
- Color[C].Name := 'P1Lightest';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- // P2
- C := C+1;
- Color[C].Name := 'P2Dark';
- Color[C].RGB := GetSystemColor(3); // 3 - red
-
- C := C+1;
- Color[C].Name := 'P2Light';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- C := C+1;
- Color[C].Name := 'P2Lightest';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- // P3
- C := C+1;
- Color[C].Name := 'P3Dark';
- Color[C].RGB := GetSystemColor(1); // 1 - green
-
- C := C+1;
- Color[C].Name := 'P3Light';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- C := C+1;
- Color[C].Name := 'P3Lightest';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- // P4
- C := C+1;
- Color[C].Name := 'P4Dark';
- Color[C].RGB := GetSystemColor(4); // 4 - brown
-
- C := C+1;
- Color[C].Name := 'P4Light';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- C := C+1;
- Color[C].Name := 'P4Lightest';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- // P5
- C := C+1;
- Color[C].Name := 'P5Dark';
- Color[C].RGB := GetSystemColor(5); // 5 - yellow
-
- C := C+1;
- Color[C].Name := 'P5Light';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- C := C+1;
- Color[C].Name := 'P5Lightest';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- // P6
- C := C+1;
- Color[C].Name := 'P6Dark';
- Color[C].RGB := GetSystemColor(6); // 6 - violet
-
- C := C+1;
- Color[C].Name := 'P6Light';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- C := C+1;
- Color[C].Name := 'P6Lightest';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
-
- SL.Free;
-end;
-
-function ColorExists(Name: string): integer;
-var
- C: integer;
-begin
- Result := -1;
- for C := 0 to High(Color) do
- if Color[C].Name = Name then
- Result := C;
-end;
-
-procedure LoadColor(var R, G, B: real; ColorName: string);
-var
- C: integer;
-begin
- C := ColorExists(ColorName);
- if C >= 0 then
- begin
- R := Color[C].RGB.R;
- G := Color[C].RGB.G;
- B := Color[C].RGB.B;
- end;
-end;
-
-function GetSystemColor(Color: integer): TRGB;
-begin
- case Color of
- 0: begin
- // blue
- Result.R := 71/255;
- Result.G := 175/255;
- Result.B := 247/255;
- end;
- 1: begin
- // green
- Result.R := 63/255;
- Result.G := 191/255;
- Result.B := 63/255;
- end;
- 2: begin
- // pink
- Result.R := 255/255;
-{ Result.G := 63/255;
- Result.B := 192/255;}
- Result.G := 175/255;
- Result.B := 247/255;
- end;
- 3: begin
- // red
- Result.R := 247/255;
- Result.G := 71/255;
- Result.B := 71/255;
- end;
- //'Violet', 'Orange', 'Yellow', 'Brown', 'Black'
- //New Theme-Color Patch
- 4: begin
- // violet
- Result.R := 230/255;
- Result.G := 63/255;
- Result.B := 230/255;
- end;
- 5: begin
- // orange
- Result.R := 255/255;
- Result.G := 144/255;
- Result.B := 0;
- end;
- 6: begin
- // yellow
- Result.R := 230/255;
- Result.G := 230/255;
- Result.B := 95/255;
- end;
- 7: begin
- // brown
- Result.R := 192/255;
- Result.G := 127/255;
- Result.B := 31/255;
- end;
- 8: begin
- // black
- Result.R := 0;
- Result.G := 0;
- Result.B := 0;
- end;
- //New Theme-Color Patch End
-
- end;
-end;
-
-function ColorSqrt(RGB: TRGB): TRGB;
-begin
- Result.R := sqrt(RGB.R);
- Result.G := sqrt(RGB.G);
- Result.B := sqrt(RGB.B);
-end;
-
-procedure TTheme.ThemeSave(const FileName: string);
-var
- I: integer;
-begin
- {$IFDEF THEMESAVE}
- ThemeIni := TIniFile.Create(FileName);
- {$ELSE}
- ThemeIni := TMemIniFile.Create(FileName);
- {$ENDIF}
-
- ThemeSaveBasic(Loading, 'Loading');
-
- ThemeSaveBasic(Main, 'Main');
- ThemeSaveText(Main.TextDescription, 'MainTextDescription');
- ThemeSaveText(Main.TextDescriptionLong, 'MainTextDescriptionLong');
- ThemeSaveButton(Main.ButtonSolo, 'MainButtonSolo');
- ThemeSaveButton(Main.ButtonEditor, 'MainButtonEditor');
- ThemeSaveButton(Main.ButtonOptions, 'MainButtonOptions');
- ThemeSaveButton(Main.ButtonExit, 'MainButtonExit');
-
- ThemeSaveBasic(Name, 'Name');
- for I := 1 to 6 do
- ThemeSaveButton(Name.ButtonPlayer[I], 'NameButtonPlayer' + IntToStr(I));
-
- ThemeSaveBasic(Level, 'Level');
- ThemeSaveButton(Level.ButtonEasy, 'LevelButtonEasy');
- ThemeSaveButton(Level.ButtonMedium, 'LevelButtonMedium');
- ThemeSaveButton(Level.ButtonHard, 'LevelButtonHard');
-
- ThemeSaveBasic(Song, 'Song');
- ThemeSaveText(Song.TextArtist, 'SongTextArtist');
- ThemeSaveText(Song.TextTitle, 'SongTextTitle');
- ThemeSaveText(Song.TextNumber, 'SongTextNumber');
-
- //Show CAt in Top Left Mod
- ThemeSaveText(Song.TextCat, 'SongTextCat');
- ThemeSaveStatic(Song.StaticCat, 'SongStaticCat');
-
- ThemeSaveBasic(Sing, 'Sing');
-
- //TimeBar mod
- ThemeSaveStatic(Sing.StaticTimeProgress, 'SingTimeProgress');
- ThemeSaveText(Sing.TextTimeText, 'SingTimeText');
- //eoa TimeBar mod
-
- ThemeSaveStatic(Sing.StaticP1, 'SingP1Static');
- ThemeSaveText(Sing.TextP1, 'SingP1Text');
- ThemeSaveStatic(Sing.StaticP1ScoreBG, 'SingP1Static2');
- ThemeSaveText(Sing.TextP1Score, 'SingP1TextScore');
-
- //moveable singbar mod
- ThemeSaveStatic(Sing.StaticP1SingBar, 'SingP1SingBar');
- ThemeSaveStatic(Sing.StaticP1TwoPSingBar, 'SingP1TwoPSingBar');
- ThemeSaveStatic(Sing.StaticP1ThreePSingBar, 'SingP1ThreePSingBar');
- ThemeSaveStatic(Sing.StaticP2RSingBar, 'SingP2RSingBar');
- ThemeSaveStatic(Sing.StaticP2MSingBar, 'SingP2MSingBar');
- ThemeSaveStatic(Sing.StaticP3SingBar, 'SingP3SingBar');
- //eoa moveable singbar
-
- //Added for ps3 skin
- //This one is shown in 2/4P mode
- ThemeSaveStatic(Sing.StaticP1TwoP, 'SingP1TwoPStatic');
- ThemeSaveText(Sing.TextP1TwoP, 'SingP1TwoPText');
- ThemeSaveStatic(Sing.StaticP1TwoPScoreBG, 'SingP1TwoPStatic2');
- ThemeSaveText(Sing.TextP1TwoPScore, 'SingP1TwoPTextScore');
-
- //This one is shown in 3/6P mode
- ThemeSaveStatic(Sing.StaticP1ThreeP, 'SingP1ThreePStatic');
- ThemeSaveText(Sing.TextP1ThreeP, 'SingP1ThreePText');
- ThemeSaveStatic(Sing.StaticP1ThreePScoreBG, 'SingP1ThreePStatic2');
- ThemeSaveText(Sing.TextP1ThreePScore, 'SingP1ThreePTextScore');
- //eoa
-
- ThemeSaveStatic(Sing.StaticP2R, 'SingP2RStatic');
- ThemeSaveText(Sing.TextP2R, 'SingP2RText');
- ThemeSaveStatic(Sing.StaticP2RScoreBG, 'SingP2RStatic2');
- ThemeSaveText(Sing.TextP2RScore, 'SingP2RTextScore');
-
- ThemeSaveStatic(Sing.StaticP2M, 'SingP2MStatic');
- ThemeSaveText(Sing.TextP2M, 'SingP2MText');
- ThemeSaveStatic(Sing.StaticP2MScoreBG, 'SingP2MStatic2');
- ThemeSaveText(Sing.TextP2MScore, 'SingP2MTextScore');
-
- ThemeSaveStatic(Sing.StaticP3R, 'SingP3RStatic');
- ThemeSaveText(Sing.TextP3R, 'SingP3RText');
- ThemeSaveStatic(Sing.StaticP3RScoreBG, 'SingP3RStatic2');
- ThemeSaveText(Sing.TextP3RScore, 'SingP3RTextScore');
-
- ThemeSaveBasic(Score, 'Score');
- ThemeSaveText(Score.TextArtist, 'ScoreTextArtist');
- ThemeSaveText(Score.TextTitle, 'ScoreTextTitle');
-
- for I := 1 to 6 do
- begin
- ThemeSaveStatics(Score.PlayerStatic[I], 'ScorePlayer' + IntToStr(I) + 'Static');
-
- ThemeSaveText(Score.TextName[I], 'ScoreTextName' + IntToStr(I));
- ThemeSaveText(Score.TextScore[I], 'ScoreTextScore' + IntToStr(I));
- ThemeSaveText(Score.TextNotes[I], 'ScoreTextNotes' + IntToStr(I));
- ThemeSaveText(Score.TextNotesScore[I], 'ScoreTextNotesScore' + IntToStr(I));
- ThemeSaveText(Score.TextLineBonus[I], 'ScoreTextLineBonus' + IntToStr(I));
- ThemeSaveText(Score.TextLineBonusScore[I], 'ScoreTextLineBonusScore' + IntToStr(I));
- ThemeSaveText(Score.TextGoldenNotes[I], 'ScoreTextGoldenNotes' + IntToStr(I));
- ThemeSaveText(Score.TextGoldenNotesScore[I], 'ScoreTextGoldenNotesScore' + IntToStr(I));
- ThemeSaveText(Score.TextTotal[I], 'ScoreTextTotal' + IntToStr(I));
- ThemeSaveText(Score.TextTotalScore[I], 'ScoreTextTotalScore' + IntToStr(I));
-
- ThemeSaveStatic(Score.StaticBackLevel[I], 'ScoreStaticBackLevel' + IntToStr(I));
- ThemeSaveStatic(Score.StaticBackLevelRound[I], 'ScoreStaticBackLevelRound' + IntToStr(I));
- ThemeSaveStatic(Score.StaticLevel[I], 'ScoreStaticLevel' + IntToStr(I));
- ThemeSaveStatic(Score.StaticLevelRound[I], 'ScoreStaticLevelRound' + IntToStr(I));
- end;
-
- ThemeSaveBasic(Top5, 'Top5');
- ThemeSaveText(Top5.TextLevel, 'Top5TextLevel');
- ThemeSaveText(Top5.TextArtistTitle, 'Top5TextArtistTitle');
- ThemeSaveStatics(Top5.StaticNumber, 'Top5StaticNumber');
- ThemeSaveTexts(Top5.TextNumber, 'Top5TextNumber');
- ThemeSaveTexts(Top5.TextName, 'Top5TextName');
- ThemeSaveTexts(Top5.TextScore, 'Top5TextScore');
-
-
- ThemeIni.Free;
-end;
-
-procedure TTheme.ThemeSaveBasic(Theme: TThemeBasic; const Name: string);
-begin
- ThemeIni.WriteInteger(Name, 'Texts', Length(Theme.Text));
-
- ThemeSaveBackground(Theme.Background, Name + 'Background');
- ThemeSaveStatics(Theme.Static, Name + 'Static');
- ThemeSaveTexts(Theme.Text, Name + 'Text');
-end;
-
-procedure TTheme.ThemeSaveBackground(ThemeBackground: TThemeBackground; const Name: string);
-begin
- if ThemeBackground.Tex <> '' then
- ThemeIni.WriteString(Name, 'Tex', ThemeBackground.Tex)
- else
- begin
- ThemeIni.EraseSection(Name);
- end;
-end;
-
-procedure TTheme.ThemeSaveStatic(ThemeStatic: TThemeStatic; const Name: string);
-begin
- ThemeIni.WriteInteger(Name, 'X', ThemeStatic.X);
- ThemeIni.WriteInteger(Name, 'Y', ThemeStatic.Y);
- ThemeIni.WriteInteger(Name, 'W', ThemeStatic.W);
- ThemeIni.WriteInteger(Name, 'H', ThemeStatic.H);
-
- ThemeIni.WriteString(Name, 'Tex', ThemeStatic.Tex);
- ThemeIni.WriteString(Name, 'Type', TextureTypeToStr(ThemeStatic.Typ));
- ThemeIni.WriteString(Name, 'Color', ThemeStatic.Color);
-
- ThemeIni.WriteFloat(Name, 'TexX1', ThemeStatic.TexX1);
- ThemeIni.WriteFloat(Name, 'TexY1', ThemeStatic.TexY1);
- ThemeIni.WriteFloat(Name, 'TexX2', ThemeStatic.TexX2);
- ThemeIni.WriteFloat(Name, 'TexY2', ThemeStatic.TexY2);
-end;
-
-procedure TTheme.ThemeSaveStatics(ThemeStatic: AThemeStatic; const Name: string);
-var
- S: integer;
-begin
- for S := 0 to Length(ThemeStatic)-1 do
- ThemeSaveStatic(ThemeStatic[S], Name + {'Static' +} IntToStr(S+1));
-
- ThemeIni.EraseSection(Name + {'Static' + }IntToStr(S+1));
-end;
-
-procedure TTheme.ThemeSaveText(ThemeText: TThemeText; const Name: string);
-begin
- ThemeIni.WriteInteger(Name, 'X', ThemeText.X);
- ThemeIni.WriteInteger(Name, 'Y', ThemeText.Y);
-
- ThemeIni.WriteInteger(Name, 'Font', ThemeText.Font);
- ThemeIni.WriteInteger(Name, 'Size', ThemeText.Size);
- ThemeIni.WriteInteger(Name, 'Align', ThemeText.Align);
-
- ThemeIni.WriteString(Name, 'Text', ThemeText.Text);
- ThemeIni.WriteString(Name, 'Color', ThemeText.Color);
-
- ThemeIni.WriteBool(Name, 'Reflection', ThemeText.Reflection);
- ThemeIni.WriteFloat(Name, 'ReflectionSpacing', ThemeText.ReflectionSpacing);
-end;
-
-procedure TTheme.ThemeSaveTexts(ThemeText: AThemeText; const Name: string);
-var
- T: integer;
-begin
- for T := 0 to Length(ThemeText)-1 do
- ThemeSaveText(ThemeText[T], Name + {'Text' + }IntToStr(T+1));
-
- ThemeIni.EraseSection(Name + {'Text' + }IntToStr(T+1));
-end;
-
-procedure TTheme.ThemeSaveButton(ThemeButton: TThemeButton; const Name: string);
-var
- T: integer;
-begin
- ThemeIni.WriteString(Name, 'Tex', ThemeButton.Tex);
- ThemeIni.WriteInteger(Name, 'X', ThemeButton.X);
- ThemeIni.WriteInteger(Name, 'Y', ThemeButton.Y);
- ThemeIni.WriteInteger(Name, 'W', ThemeButton.W);
- ThemeIni.WriteInteger(Name, 'H', ThemeButton.H);
- ThemeIni.WriteString(Name, 'Type', TextureTypeToStr(ThemeButton.Typ));
- ThemeIni.WriteInteger(Name, 'Texts', Length(ThemeButton.Text));
-
- ThemeIni.WriteString(Name, 'Color', ThemeButton.Color);
-
-{ ThemeButton.ColR := ThemeIni.ReadFloat(Name, 'ColR', 1);
- ThemeButton.ColG := ThemeIni.ReadFloat(Name, 'ColG', 1);
- ThemeButton.ColB := ThemeIni.ReadFloat(Name, 'ColB', 1);
- ThemeButton.Int := ThemeIni.ReadFloat(Name, 'Int', 1);
- ThemeButton.DColR := ThemeIni.ReadFloat(Name, 'DColR', 1);
- ThemeButton.DColG := ThemeIni.ReadFloat(Name, 'DColG', 1);
- ThemeButton.DColB := ThemeIni.ReadFloat(Name, 'DColB', 1);
- ThemeButton.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1);}
-
-{ C := ColorExists(ThemeIni.ReadString(Name, 'Color', ''));
- if C >= 0 then
- begin
- ThemeButton.ColR := Color[C].RGB.R;
- ThemeButton.ColG := Color[C].RGB.G;
- ThemeButton.ColB := Color[C].RGB.B;
- end;
-
- C := ColorExists(ThemeIni.ReadString(Name, 'DColor', ''));
- if C >= 0 then
- begin
- ThemeButton.DColR := Color[C].RGB.R;
- ThemeButton.DColG := Color[C].RGB.G;
- ThemeButton.DColB := Color[C].RGB.B;
- end;}
-
- for T := 0 to High(ThemeButton.Text) do
- ThemeSaveText(ThemeButton.Text[T], Name + 'Text' + IntToStr(T+1));
-end;
-
-procedure TTheme.CreateThemeObjects();
-begin
- freeandnil(Loading);
- Loading := TThemeLoading.Create;
-
- freeandnil(Main);
- Main := TThemeMain.Create;
-
- freeandnil(Name);
- Name := TThemeName.Create;
-
- freeandnil(Level);
- Level := TThemeLevel.Create;
-
- freeandnil(Song);
- Song := TThemeSong.Create;
-
- freeandnil(Sing);
- Sing := TThemeSing.Create;
-
- freeandnil(Score);
- Score := TThemeScore.Create;
-
- freeandnil(Top5);
- Top5 := TThemeTop5.Create;
-
- freeandnil(Options);
- Options := TThemeOptions.Create;
-
- freeandnil(OptionsGame);
- OptionsGame := TThemeOptionsGame.Create;
-
- freeandnil(OptionsGraphics);
- OptionsGraphics := TThemeOptionsGraphics.Create;
-
- freeandnil(OptionsSound);
- OptionsSound := TThemeOptionsSound.Create;
-
- freeandnil(OptionsLyrics);
- OptionsLyrics := TThemeOptionsLyrics.Create;
-
- freeandnil(OptionsThemes);
- OptionsThemes := TThemeOptionsThemes.Create;
-
- freeandnil(OptionsRecord);
- OptionsRecord := TThemeOptionsRecord.Create;
-
- freeandnil(OptionsAdvanced);
- OptionsAdvanced := TThemeOptionsAdvanced.Create;
-
- freeandnil(Edit);
- Edit := TThemeEdit.Create;
-
- freeandnil(ErrorPopup);
- ErrorPopup := TThemeError.Create;
-
- freeandnil(CheckPopup);
- CheckPopup := TThemeCheck.Create;
-
- freeandnil(SongMenu);
- SongMenu := TThemeSongMenu.Create;
-
- freeandnil(SongJumpto);
- SongJumpto := TThemeSongJumpto.Create;
-
- //Party Screens
- freeandnil(PartyNewRound);
- PartyNewRound := TThemePartyNewRound.Create;
-
- freeandnil(PartyWin);
- PartyWin := TThemePartyWin.Create;
-
- freeandnil(PartyScore);
- PartyScore := TThemePartyScore.Create;
-
- freeandnil(PartyOptions);
- PartyOptions := TThemePartyOptions.Create;
-
- freeandnil(PartyPlayer);
- PartyPlayer := TThemePartyPlayer.Create;
-
- //Stats Screens:
- freeandnil(StatMain);
- StatMain := TThemeStatMain.Create;
-
- freeandnil(StatDetail);
- StatDetail := TThemeStatDetail.Create;
-
- end;
-
-end.
diff --git a/src/base/UUnicodeUtils.pas b/src/base/UUnicodeUtils.pas
deleted file mode 100644
index 37b53a67..00000000
--- a/src/base/UUnicodeUtils.pas
+++ /dev/null
@@ -1,670 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UUnicodeUtils;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-uses
-{$IFDEF MSWINDOWS}
- Windows,
-{$ENDIF}
- StrUtils,
- SysUtils;
-
-type
- // String with unknown encoding. Introduced with Delphi 2009 and maybe soon
- // with FPC.
- RawByteString = AnsiString;
-
-{**
- * Returns true if the system uses UTF-8 as default string type
- * (filesystem or API calls).
- * This is always true on Mac OS X and always false on Win32. On Unix it depends
- * on the LC_CTYPE setting.
- * Do not use AnsiToUTF8() or UTF8ToAnsi() if this function returns true.
- *}
-function IsNativeUTF8(): boolean;
-
-(*
- * Character classes
- *)
-
-function IsAlphaChar(ch: WideChar): boolean; overload;
-function IsAlphaChar(ch: UCS4Char): boolean; overload;
-
-function IsNumericChar(ch: WideChar): boolean; overload;
-function IsNumericChar(ch: UCS4Char): boolean; overload;
-
-function IsAlphaNumericChar(ch: WideChar): boolean; overload;
-function IsAlphaNumericChar(ch: UCS4Char): boolean; overload;
-
-function IsPunctuationChar(ch: WideChar): boolean; overload;
-function IsPunctuationChar(ch: UCS4Char): boolean; overload;
-
-function IsControlChar(ch: WideChar): boolean; overload;
-function IsControlChar(ch: UCS4Char): boolean; overload;
-
-function IsPrintableChar(ch: WideChar): boolean; overload;
-function IsPrintableChar(ch: UCS4Char): boolean; overload;
-
-{**
- * Checks if the given string is a valid UTF-8 string.
- * If an ANSI encoded string (with char codes >= 128) is passed, the
- * function will most probably return false, as most ANSI strings sequences
- * are illegal in UTF-8.
- *}
-function IsUTF8String(const str: RawByteString): boolean;
-
-{**
- * Iterates over an UTF-8 encoded string.
- * StrPtr will be increased to the beginning of the next character on each
- * call.
- * Results true if the given string starts with an UTF-8 encoded char.
- *}
-function NextCharUTF8(var StrPtr: PAnsiChar; out Ch: UCS4Char): boolean;
-
-{**
- * Deletes Count chars (not bytes) beginning at char- (not byte-) position Index.
- * Index values start with 1.
- *}
-procedure UTF8Delete(var Str: UTF8String; Index: Integer; Count: Integer);
-procedure UCS4Delete(var Str: UCS4String; Index: Integer; Count: Integer);
-
-{**
- * Checks if the string is composed of ASCII characters.
- *}
-function IsASCIIString(const str: RawByteString): boolean;
-
-{*
- * String format conversion
- *}
-
-function UTF8ToUCS4String(const str: UTF8String): UCS4String;
-function UCS4ToUTF8String(const str: UCS4String): UTF8String; overload;
-function UCS4ToUTF8String(ch: UCS4Char): UTF8String; overload;
-
-{**
- * Returns the number of characters (not bytes) in string str.
- *}
-function LengthUTF8(const str: UTF8String): integer;
-
-{**
- * Returns the length of an UCS4String. Note that Length(UCS4String) returns
- * the length+1 as UCS4Strings are zero-terminated.
- *}
-function LengthUCS4(const str: UCS4String): integer;
-
-{** @seealso WideCompareStr *}
-function UTF8CompareStr(const S1, S2: UTF8String): integer;
-{** @seealso WideCompareText *}
-function UTF8CompareText(const S1, S2: UTF8String): integer;
-
-function UTF8StartsText(const SubText, Text: UTF8String): boolean;
-
-function UTF8ContainsStr(const Text, SubText: UTF8String): boolean;
-function UTF8ContainsText(const Text, SubText: UTF8String): boolean;
-
-{** @seealso WideUpperCase *}
-function UTF8UpperCase(const str: UTF8String): UTF8String;
-{** @seealso WideCompareText *}
-function UTF8LowerCase(const str: UTF8String): UTF8String;
-
-{**
- * Converts a UCS-4 char ch to its upper-case representation.
- *}
-function UCS4UpperCase(ch: UCS4Char): UCS4Char; overload;
-
-{**
- * Converts a UCS-4 string str to its upper-case representation.
- *}
-function UCS4UpperCase(const str: UCS4String): UCS4String; overload;
-
-{**
- * Converts a UCS4Char to an UCS4String.
- * Note that UCS4Strings are zero-terminated dynamic arrays.
- *}
-function UCS4CharToString(ch: UCS4Char): UCS4String;
-
-{**
- * @seealso System.Pos()
- *}
-function UTF8Pos(const substr: UTF8String; const str: UTF8String): Integer;
-
-{**
- * Copies a segment of str starting with Index (1-based) with Count characters (not bytes).
- *}
-function UTF8Copy(const str: UTF8String; Index: Integer = 1; Count: Integer = -1): UTF8String;
-
-{**
- * Copies a segment of str starting with Index (0-based) with Count characters.
- * Note: Do not use Copy() to copy UCS4Strings as the result will not contain
- * a trailing #0 character and hence is invalid.
- *}
-function UCS4Copy(const str: UCS4String; Index: Integer = 0; Count: Integer = -1): UCS4String;
-
-(*
- * Converts a WideString to its upper- or lower-case representation.
- * Wrapper for WideUpper/LowerCase. Needed because some plattforms have
- * problems with unicode support.
- *
- * Note that characters in UTF-16 might consist of one or two WideChar valus
- * (see surrogates). So instead of using WideStringUpperCase(ch)[1] for single
- * character access, convert to UCS-4 where each character is represented by
- * one UCS4Char.
- *)
-function WideStringUpperCase(const str: WideString) : WideString; overload;
-function WideStringUpperCase(ch: WideChar): WideString; overload;
-function WideStringLowerCase(const str: WideString): WideString; overload;
-function WideStringLowerCase(ch: WideChar): WideString; overload;
-
-function WideStringReplaceChar(const text: WideString; search, rep: WideChar): WideString;
-
-implementation
-
-{$IFDEF UNIX}
-{$IFNDEF DARWIN}
-const
- LC_CTYPE = 0;
-
-function setlocale(category: integer; locale: PChar): PChar; cdecl; external 'c';
-{$ENDIF}
-{$ENDIF}
-
-var
- NativeUTF8: boolean;
-
-procedure InitUnicodeUtils();
-{$IFDEF UNIX}
-{$IFNDEF DARWIN}
-var
- localeName: PChar;
-{$ENDIF}
-{$ENDIF}
-begin
- {$IF Defined(DARWIN)}
- NativeUTF8 := true;
- {$ELSEIF Defined(MSWindows)}
- NativeUTF8 := false;
- {$ELSEIF Defined(UNIX)}
- // check if locale name contains UTF8 or UTF-8
- localeName := setlocale(LC_CTYPE, nil);
- NativeUTF8 := Pos('UTF8', UpperCase(AnsiReplaceStr(localeName, '-', ''))) > 0;
- {$ELSE}
- raise Exception.Create('Unknown system');
- {$IFEND}
-end;
-
-function IsNativeUTF8(): boolean;
-begin
- Result := NativeUTF8;
-end;
-
-function IsAlphaChar(ch: WideChar): boolean;
-begin
- {$IFDEF MSWINDOWS}
- Result := IsCharAlphaW(ch);
- {$ELSE}
- // TODO: add chars > 255 (or replace with libxml2 functions?)
- case ch of
- 'A'..'Z', // A-Z
- 'a'..'z', // a-z
- #170,#181,#186,
- #192..#214,
- #216..#246,
- #248..#255:
- Result := true;
- else
- Result := false;
- end;
- {$ENDIF}
-end;
-
-function IsAlphaChar(ch: UCS4Char): boolean;
-begin
- Result := IsAlphaChar(WideChar(Ord(ch)));
-end;
-
-function IsNumericChar(ch: WideChar): boolean;
-begin
- // TODO: replace with libxml2 functions?
- // ignore non-arabic numerals as we do not want to handle them
- case ch of
- '0'..'9':
- Result := true;
- else
- Result := false;
- end;
-end;
-
-function IsNumericChar(ch: UCS4Char): boolean;
-begin
- Result := IsNumericChar(WideChar(Ord(ch)));
-end;
-
-function IsAlphaNumericChar(ch: WideChar): boolean;
-begin
- Result := (IsAlphaChar(ch) or IsNumericChar(ch));
-end;
-
-function IsAlphaNumericChar(ch: UCS4Char): boolean;
-begin
- Result := (IsAlphaChar(ch) or IsNumericChar(ch));
-end;
-
-function IsPunctuationChar(ch: WideChar): boolean;
-begin
- // TODO: add chars > 255 (or replace with libxml2 functions?)
- case ch of
- ' '..'/',':'..'@','['..'`','{'..'~',
- #160..#191,#215,#247:
- Result := true;
- else
- Result := false;
- end;
-end;
-
-function IsPunctuationChar(ch: UCS4Char): boolean;
-begin
- Result := IsPunctuationChar(WideChar(Ord(ch)));
-end;
-
-function IsControlChar(ch: WideChar): boolean;
-begin
- case ch of
- #0..#31,
- #127..#159:
- Result := true;
- else
- Result := false;
- end;
-end;
-
-function IsControlChar(ch: UCS4Char): boolean;
-begin
- Result := IsControlChar(WideChar(Ord(ch)));
-end;
-
-function IsPrintableChar(ch: WideChar): boolean;
-begin
- Result := not IsControlChar(ch);
-end;
-
-function IsPrintableChar(ch: UCS4Char): boolean;
-begin
- Result := IsPrintableChar(WideChar(Ord(ch)));
-end;
-
-
-function NextCharUTF8(var StrPtr: PAnsiChar; out Ch: UCS4Char): boolean;
-
- // find the most significant zero bit (Result: [7..-1])
- function FindZeroMSB(b: byte): integer;
- var
- Mask: byte;
- begin
- Mask := $80;
- Result := 7;
- while (b and Mask <> 0) do
- begin
- Mask := Mask shr 1;
- Dec(Result);
- end;
- end;
-
-var
- ZeroBit: integer;
- SeqCount: integer; // number of trailing bytes to follow
-const
- Mask: array[1..3] of byte = ($1F, $0F, $07);
-begin
- Result := false;
- SeqCount := 0;
- Ch := 0;
-
- while (StrPtr^ <> #0) do
- begin
- if (StrPtr^ < #128) then
- begin
- // check that no more trailing bytes are expected
- if (SeqCount = 0) then
- begin
- Ch := Ord(StrPtr^);
- Inc(StrPtr);
- Result := true;
- end;
- Break;
- end
- else
- begin
- ZeroBit := FindZeroMSB(Ord(StrPtr^));
- // trailing byte expected
- if (SeqCount > 0) then
- begin
- // check if trailing byte has pattern 10xxxxxx
- if (ZeroBit <> 6) then
- begin
- Inc(StrPtr);
- Break;
- end;
-
- Dec(SeqCount);
- Ch := (Ch shl 6) or (Ord(StrPtr^) and $3F);
-
- // check if char is finished
- if (SeqCount = 0) then
- begin
- Inc(StrPtr);
- Result := true;
- Break;
- end;
- end
- else // leading byte expected
- begin
- // check if pattern is one of 110xxxxx/1110xxxx/11110xxx
- if (ZeroBit > 5) or (ZeroBit < 3) then
- begin
- Inc(StrPtr);
- Break;
- end;
- // calculate number of trailing bytes (1, 2 or 3)
- SeqCount := 6 - ZeroBit;
- // extract first part of char
- Ch := Ord(StrPtr^) and Mask[SeqCount];
- end;
- end;
-
- Inc(StrPtr);
- end;
-
- if (not Result) then
- Ch := Ord('?');
-end;
-
-function IsUTF8String(const str: RawByteString): boolean;
-var
- Ch: UCS4Char;
- StrPtr: PAnsiChar;
-begin
- Result := true;
- StrPtr := PChar(str);
- while (StrPtr^ <> #0) do
- begin
- if (not NextCharUTF8(StrPtr, Ch)) then
- begin
- Result := false;
- Exit;
- end;
- end;
-end;
-
-function IsASCIIString(const str: RawByteString): boolean;
-var
- I: integer;
-begin
- for I := 1 to Length(str) do
- begin
- if (str[I] >= #128) then
- begin
- Result := false;
- Exit;
- end;
- end;
- Result := true;
-end;
-
-
-function UTF8ToUCS4String(const str: UTF8String): UCS4String;
-begin
- Result := WideStringToUCS4String(UTF8Decode(str));
-end;
-
-function UCS4ToUTF8String(const str: UCS4String): UTF8String;
-begin
- Result := UTF8Encode(UCS4StringToWideString(str));
-end;
-
-function UCS4ToUTF8String(ch: UCS4Char): UTF8String;
-begin
- Result := UCS4ToUTF8String(UCS4CharToString(ch));
-end;
-
-function LengthUTF8(const str: UTF8String): integer;
-begin
- Result := LengthUCS4(UTF8ToUCS4String(str));
-end;
-
-function LengthUCS4(const str: UCS4String): integer;
-begin
- Result := High(str);
- if (Result = -1) then
- Result := 0;
-end;
-
-function UTF8CompareStr(const S1, S2: UTF8String): integer;
-begin
- Result := WideCompareStr(UTF8Decode(S1), UTF8Decode(S2));
-end;
-
-function UTF8CompareText(const S1, S2: UTF8String): integer;
-begin
- Result := WideCompareText(UTF8Decode(S1), UTF8Decode(S2));
-end;
-
-function UTF8StartsStr(const SubText, Text: UTF8String): boolean;
-begin
- // TODO: use WideSameStr (slower but handles different representations of the same char)?
- Result := (Pos(SubText, Text) = 1);
-end;
-
-function UTF8StartsText(const SubText, Text: UTF8String): boolean;
-begin
- // TODO: use WideSameText (slower but handles different representations of the same char)?
- Result := (Pos(UTF8UpperCase(SubText), UTF8UpperCase(Text)) = 1);
-end;
-
-function UTF8ContainsStr(const Text, SubText: UTF8String): boolean;
-begin
- Result := Pos(SubText, Text) > 0;
-end;
-
-function UTF8ContainsText(const Text, SubText: UTF8String): boolean;
-begin
- Result := Pos(UTF8UpperCase(SubText), UTF8UpperCase(Text)) > 0;
-end;
-
-function UTF8UpperCase(const str: UTF8String): UTF8String;
-begin
- Result := UTF8Encode(WideStringUpperCase(UTF8Decode(str)));
-end;
-
-function UTF8LowerCase(const str: UTF8String): UTF8String;
-begin
- Result := UTF8Encode(WideStringLowerCase(UTF8Decode(str)));
-end;
-
-function UCS4UpperCase(ch: UCS4Char): UCS4Char;
-begin
- Result := UCS4UpperCase(UCS4CharToString(ch))[0];
-end;
-
-function UCS4UpperCase(const str: UCS4String): UCS4String;
-begin
- // convert to upper-case as WideString and convert result back to UCS-4
- Result := WideStringToUCS4String(
- WideStringUpperCase(
- UCS4StringToWideString(str)));
-end;
-
-function UCS4CharToString(ch: UCS4Char): UCS4String;
-begin
- SetLength(Result, 2);
- Result[0] := ch;
- Result[1] := 0;
-end;
-
-function UTF8Pos(const substr: UTF8String; const str: UTF8String): Integer;
-begin
- Result := Pos(substr, str);
-end;
-
-function UTF8Copy(const str: UTF8String; Index: Integer; Count: Integer): UTF8String;
-begin
- Result := UCS4ToUTF8String(UCS4Copy(UTF8ToUCS4String(str), Index-1, Count));
-end;
-
-function UCS4Copy(const str: UCS4String; Index: Integer; Count: Integer): UCS4String;
-var
- I: integer;
- MaxCount: integer;
-begin
- // calculate max. copy count
- MaxCount := LengthUCS4(str)-Index;
- if (MaxCount < 0) then
- MaxCount := 0;
- // adjust copy count
- if (Count > MaxCount) or (Count < 0) then
- Count := MaxCount;
-
- // copy (and add zero terminator)
- SetLength(Result, Count + 1);
- for I := 0 to Count-1 do
- Result[I] := str[Index+I];
- Result[Count] := 0;
-end;
-
-procedure UTF8Delete(var Str: UTF8String; Index: Integer; Count: Integer);
-var
- StrUCS4: UCS4String;
-begin
- StrUCS4 := UTF8ToUCS4String(str);
- UCS4Delete(StrUCS4, Index-1, Count);
- Str := UCS4ToUTF8String(StrUCS4);
-end;
-
-procedure UCS4Delete(var Str: UCS4String; Index: Integer; Count: Integer);
-var
- Len: integer;
- OldStr: UCS4String;
- I: integer;
-begin
- Len := LengthUCS4(Str);
- if (Count <= 0) or (Index < 0) or (Index >= Len) then
- Exit;
- if (Index + Count > Len) then
- Count := Len-Index;
-
- OldStr := Str;
- SetLength(Str, Len-Count+1);
- for I := 0 to Index-1 do
- Str[I] := OldStr[I];
- for I := Index+Count to Len-1 do
- Str[I-Count] := OldStr[I];
- Str[High(Str)] := 0;
-end;
-
-function WideStringUpperCase(ch: WideChar): WideString;
-begin
- // If WideChar #0 is converted to a WideString in Delphi, a string with
- // length 1 and a single char #0 is returned. In FPC an empty (length=0)
- // string will be returned. This will crash, if a non printable key was
- // pressed, its char code (#0) is translated to upper-case and the the first
- // character is accessed with Result[1].
- // We cannot catch this error in the WideString parameter variant as the string
- // has length 0 already.
-
- // Force min. string length of 1
- if (ch = #0) then
- Result := #0
- else
- Result := WideStringUpperCase(WideString(ch));
-end;
-
-function WideStringUpperCase(const str: WideString): WideString;
-begin
- // On Linux and MacOSX the cwstring unit is necessary for Unicode function-calls.
- // Otherwise you will get an EIntOverflow exception (thrown by unimplementedwidestring()).
- // The Unicode manager cwstring does not work with MacOSX at the moment because
- // of missing references to iconv.
- // Note: Should be fixed now
-
- {.$IFNDEF DARWIN}
- {.$IFDEF NOIGNORE}
- Result := WideUpperCase(str)
- {.$ELSE}
- //Result := UTF8Decode(UpperCase(UTF8Encode(str)));
- {.$ENDIF}
-end;
-
-function WideStringLowerCase(ch: WideChar): WideString;
-begin
- // see WideStringUpperCase
- if (ch = #0) then
- Result := #0
- else
- Result := WideStringLowerCase(WideString(ch));
-end;
-
-function WideStringLowerCase(const str: WideString): WideString;
-begin
- // see WideStringUpperCase
- Result := WideLowerCase(str)
-end;
-
-function WideStringReplaceChar(const text: WideString; search, rep: WideChar): WideString;
-var
- iPos : integer;
-// sTemp : WideString;
-begin
-(*
- result := text;
- iPos := Pos(search, result);
- while (iPos > 0) do
- begin
- sTemp := copy(result, iPos + length(search), length(result));
- result := copy(result, 1, iPos - 1) + rep + sTEmp;
- iPos := Pos(search, result);
- end;
-*)
- result := text;
-
- if search = rep then
- exit;
-
- for iPos := 1 to length(result) do
- begin
- if result[iPos] = search then
- result[iPos] := rep;
- end;
-end;
-
-initialization
- InitUnicodeUtils;
-
-end.
diff --git a/src/base/UXMLSong.pas b/src/base/UXMLSong.pas
deleted file mode 100644
index e9751eba..00000000
--- a/src/base/UXMLSong.pas
+++ /dev/null
@@ -1,623 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * 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; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit UXMLSong;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- Classes,
- UPath,
- UUnicodeUtils;
-
-type
- TNote = record
- Start: Cardinal;
- Duration: Cardinal;
- Tone: Integer;
- NoteTyp: Byte;
- Lyric: UTF8String;
- end;
- ANote = array of TNote;
-
- TSentence = record
- Singer: Byte;
- Duration: Cardinal;
- Notes: ANote;
- end;
- ASentence = array of TSentence;
-
- TSongInfo = record
- ID: Cardinal;
- DualChannel: Boolean;
- Header: record
- Artist: UTF8String;
- Title: UTF8String;
- Gap: Cardinal;
- BPM: Real;
- Resolution: Byte;
- Edition: UTF8String;
- Genre: UTF8String;
- Year: UTF8String;
- Language: UTF8String;
- end;
- CountSentences: Cardinal;
- Sentences: ASentence;
- end;
-
- TParser = class
- private
- SSFile: TStringList;
-
- ParserState: Byte;
- CurPosinSong: Cardinal; //Cur Beat Pos in the Song
- CurDuettSinger: Byte; //Who sings this Part?
- BindLyrics: Boolean; //Should the Lyrics be bind to the last Word (no Space)
- FirstNote: Boolean; //Is this the First Note found? For Gap calculating
-
- function ParseLine(Line: RawByteString): Boolean;
- public
- SongInfo: TSongInfo;
- ErrorMessage: string;
- Edition: UTF8String;
- SingstarVersion: string;
-
- Settings: record
- DashReplacement: Char;
- end;
-
- constructor Create;
-
- function ParseConfigForEdition(const Filename: IPath): String;
-
- function ParseSongHeader(const Filename: IPath): Boolean; //Parse Song Header only
- function ParseSong (const Filename: IPath): Boolean; //Parse whole Song
- end;
-
-const
- PS_None = 0;
- PS_Melody = 1;
- PS_Sentence = 2;
-
- NT_Normal = 1;
- NT_Freestyle = 0;
- NT_Golden = 2;
-
- DS_Player1 = 1;
- DS_Player2 = 2;
- DS_Both = 3;
-
-implementation
-
-uses
- SysUtils,
- StrUtils;
-
-constructor TParser.Create;
-begin
- inherited Create;
- ErrorMessage := '';
-
- DecimalSeparator := '.';
-end;
-
-function TParser.ParseSong(const Filename: IPath): Boolean;
-var
- I: Integer;
- FileStream: TBinaryFileStream;
-begin
- Result := False;
- if Filename.IsFile() then
- begin
- ErrorMessage := 'Can''t open melody.xml file';
-
- SSFile := TStringList.Create;
- FileStream := TBinaryFileStream.Create(Filename, fmOpenRead);
- try
- SSFile.LoadFromStream(FileStream);
-
- ErrorMessage := '';
- Result := True;
-
- I := 0;
-
- SongInfo.CountSentences := 0;
- CurDuettSinger := DS_Both; //Both is Singstar Standard
- CurPosinSong := 0; //Start at Pos 0
- BindLyrics := True; //Dont start with Space
- FirstNote := True; //First Note found should be the First Note ;)
-
- SongInfo.Header.Language := '';
- SongInfo.Header.Edition := Edition;
- SongInfo.DualChannel := False;
-
- ParserState := PS_None;
-
- SetLength(SongInfo.Sentences, 0);
-
- while Result and (I < SSFile.Count) do
- begin
- Result := ParseLine(SSFile.Strings[I]);
-
- Inc(I);
- end;
-
- finally
- SSFile.Free;
- FileStream.Free;
- end;
- end;
-end;
-
-function TParser.ParseSongHeader (const Filename: IPath): Boolean;
-var
- I: Integer;
- Stream: TBinaryFileStream;
-begin
- Result := False;
-
- if Filename.IsFile() then
- begin
- SSFile := TStringList.Create;
- Stream := TBinaryFileStream.Create(Filename, fmOpenRead);
- try
- SSFile.LoadFromStream(Stream);
-
- If (SSFile.Count > 0) then
- begin
- Result := True;
- I := 0;
-
- SongInfo.CountSentences := 0;
- CurDuettSinger := DS_Both; //Both is Singstar Standard
- CurPosinSong := 0; //Start at Pos 0
- BindLyrics := True; //Dont start with Space
- FirstNote := True; //First Note found should be the First Note ;)
-
- SongInfo.ID := 0;
- SongInfo.Header.Language := '';
- SongInfo.Header.Edition := Edition;
- SongInfo.DualChannel := False;
- ParserState := PS_None;
-
- While (SongInfo.ID < 4) AND Result And (I < SSFile.Count) do
- begin
- Result := ParseLine(SSFile.Strings[I]);
-
- Inc(I);
- end;
- end
- else
- ErrorMessage := 'Can''t open melody.xml file';
-
- finally
- SSFile.Free;
- Stream.Free;
- end;
- end
- else
- ErrorMessage := 'Can''t find melody.xml file';
-end;
-
-Function TParser.ParseLine(Line: String): Boolean;
-var
- Tag: String;
- Values: String;
- AValues: Array of Record
- Name: String;
- Value: String;
- end;
- I, J, K: Integer;
- Duration, Tone: Integer;
- Lyric: String;
- NoteType: Byte;
-
- Procedure MakeValuesArray;
- var Len, Pos, State, StateChange: Integer;
- begin
- Len := -1;
- SetLength(AValues, Len + 1);
-
- Pos := 1;
- State := 0;
- While (Pos <= Length(Values)) AND (Pos <> 0) do
- begin
- Case State of
-
- 0: begin //Search for ValueName
- If (Values[Pos] <> ' ') AND (Values[Pos] <> '=') then
- begin
- //Found Something
- State := 1; //State search for '='
- StateChange := Pos; //Save Pos of Change
- Pos := PosEx('=', Values, Pos + 1);
- end
- else Inc(Pos); //When nothing found then go to next char
- end;
-
- 1: begin //Search for Equal Mark
- //Add New Value
- Inc(Len);
- SetLength(AValues, Len + 1);
-
- AValues[Len].Name := UpperCase(Copy(Values, StateChange, Pos - StateChange));
-
-
- State := 2; //Now Search for starting '"'
- StateChange := Pos; //Save Pos of Change
- Pos := PosEx('"', Values, Pos + 1);
- end;
-
- 2: begin //Search for starting '"' or ' ' <- End if there was no "
- If (Values[Pos] = '"') then
- begin //Found starting '"'
- State := 3; //Now Search for ending '"'
- StateChange := Pos; //Save Pos of Change
- Pos := PosEx('"', Values, Pos + 1);
- end
- else If (Values[Pos] = ' ') then //Found ending Space
- begin
- //Save Value to Array
- AValues[Len].Value := Copy(Values, StateChange + 1, Pos - StateChange - 1);
-
- //Search for next Valuename
- State := 0;
- StateChange := Pos;
- Inc(Pos);
- end;
- end;
-
- 3: begin //Search for ending '"'
- //Save Value to Array
- AValues[Len].Value := Copy(Values, StateChange + 1, Pos - StateChange - 1);
-
- //Search for next Valuename
- State := 0;
- StateChange := Pos;
- Inc(Pos);
- end;
- end;
-
- If (State >= 2) then
- begin //Save Last Value
- AValues[Len].Value := Copy(Values, StateChange + 1, Length(Values) - StateChange);
- end;
- end;
- end;
-begin
- Result := True;
-
- Line := Trim(Line);
- If (Length(Line) > 0) then
- begin
- I := Pos('<', Line);
- J := PosEx(' ', Line, I+1);
- K := PosEx('>', Line, I+1);
-
- If (J = 0) then J := K
- Else If (K < J) AND (K <> 0) then J := K; //Use nearest Tagname End indicator
- Tag := UpperCase(copy(Line, I + 1, J - I - 1));
- Values := copy(Line, J + 1, K - J - 1);
-
- Case ParserState of
- PS_None: begin//Search for Melody Tag
- If (Tag = 'MELODY') then
- begin
- Inc(SongInfo.ID); //Inc SongID when header Information is added
- MakeValuesArray;
- For I := 0 to High(AValues) do
- begin
- If (AValues[I].Name = 'TEMPO') then
- begin
- SongInfo.Header.BPM := StrtoFloatDef(AValues[I].Value, 0);
- If (SongInfo.Header.BPM <= 0) then
- begin
- Result := False;
- ErrorMessage := 'Can''t read BPM from Song';
- end;
- end
-
- Else If (AValues[I].Name = 'RESOLUTION') then
- begin
- AValues[I].Value := Uppercase(AValues[I].Value);
- //Ultrastar Resolution is "how often a Beat is split / 4"
- If (AValues[I].Value = 'HEMIDEMISEMIQUAVER') then
- SongInfo.Header.Resolution := 64 div 4
- Else If (AValues[I].Value = 'DEMISEMIQUAVER') then
- SongInfo.Header.Resolution := 32 div 4
- Else If (AValues[I].Value = 'SEMIQUAVER') then
- SongInfo.Header.Resolution := 16 div 4
- Else If (AValues[I].Value = 'QUAVER') then
- SongInfo.Header.Resolution := 8 div 4
- Else If (AValues[I].Value = 'CROTCHET') then
- SongInfo.Header.Resolution := 4 div 4
- Else
- begin //Can't understand teh Resolution :/
- Result := False;
- ErrorMessage := 'Can''t read Resolution from Song';
- end;
- end
-
- Else If (AValues[I].Name = 'GENRE') then
- begin
- SongInfo.Header.Genre := AValues[I].Value;
- end
-
- Else If (AValues[I].Name = 'YEAR') then
- begin
- SongInfo.Header.Year := AValues[I].Value;
- end
-
- Else If (AValues[I].Name = 'VERSION') then
- begin
- SingstarVersion := AValues[I].Value;
- end;
- end;
-
- ParserState := PS_Melody; //In Melody Tag
- end;
- end;
-
-
- PS_Melody: begin //Search for Sentence, Artist/Title Info or eo Melody
- If (Tag = 'SENTENCE') then
- begin
- ParserState := PS_Sentence; //Parse in a Sentence Tag now
-
- //Increase SentenceCount
- Inc(SongInfo.CountSentences);
-
- BindLyrics := True; //Don't let Txts Begin w/ Space
-
- //Search for Duett Singer Info
- MakeValuesArray;
- For I := 0 to High(AValues) do
- If (AValues[I].Name = 'SINGER') then
- begin
- AValues[I].Value := Uppercase(AValues[I].Value);
- If (AValues[I].Value = 'SOLO 1') then
- CurDuettSinger := DS_Player1
- Else If (AValues[I].Value = 'SOLO 2') then
- CurDuettSinger := DS_Player2
- Else
- CurDuettSinger := DS_Both; //In case of "Group" or anything that is not identified use Both
- end;
- end
-
- Else If (Tag = '!--') then
- begin //Comment, this may be Artist or Title Info
- I := Pos(':', Values); //Search for Delimiter
-
- If (I <> 0) then //If Found check for Title or Artist
- begin
- //Copy Title or Artist Tag to Tag String
- Tag := Uppercase(Trim(Copy(Values, 1, I - 1)));
-
- If (Tag = 'ARTIST') then
- begin
- SongInfo.Header.Artist := Trim(Copy(Values, I + 1, Length(Values) - I - 2));
- Inc(SongInfo.ID); //Inc SongID when header Information is added
- end
- Else If (Tag = 'TITLE') then
- begin
- SongInfo.Header.Title := Trim(Copy(Values, I + 1, Length(Values) - I - 2));
- Inc(SongInfo.ID); //Inc SongID when header Information is added
- end;
- end;
- end
-
- //Parsing for weird "Die toten Hosen" Tags
- Else If (Tag = '!--ARTIST:') OR (Tag = '!--ARTIST') then
- begin //Comment, with Artist Info
- I := Pos(':', Values); //Search for Delimiter
-
- Inc(SongInfo.ID); //Inc SongID when header Information is added
-
- SongInfo.Header.Artist := Trim(Copy(Values, I + 1, Length(Values) - I - 2));
- end
-
- Else If (Tag = '!--TITLE:') OR (Tag = '!--TITLE') then
- begin //Comment, with Artist Info
- I := Pos(':', Values); //Search for Delimiter
-
- Inc(SongInfo.ID); //Inc SongID when header Information is added
-
- SongInfo.Header.Title := Trim(Copy(Values, I + 1, Length(Values) - I - 2));
- end
-
- Else If (Tag = '/MELODY') then
- begin
- ParserState := PS_None;
- Exit; //Stop Parsing, Melody iTag ended
- end
- end;
-
-
- PS_Sentence: begin //Search for Notes or eo Sentence
- If (Tag = 'NOTE') then
- begin //Found Note
- //Get Values
- MakeValuesArray;
-
- NoteType := NT_Normal;
- For I := 0 to High(AValues) do
- begin
- If (AValues[I].Name = 'DURATION') then
- begin
- Duration := StrtoIntDef(AValues[I].Value, -1);
- If (Duration < 0) then
- begin
- Result := False;
- ErrorMessage := 'Can''t read duration from Note in Line: "' + Line + '"';
- Exit;
- end;
- end
- Else If (AValues[I].Name = 'MIDINOTE') then
- begin
- Tone := StrtoIntDef(AValues[I].Value, 0);
- end
- Else If (AValues[I].Name = 'BONUS') AND (Uppercase(AValues[I].Value) = 'YES') then
- begin
- NoteType := NT_Golden;
- end
- Else If (AValues[I].Name = 'FREESTYLE') AND (Uppercase(AValues[I].Value) = 'YES') then
- begin
- NoteType := NT_Freestyle;
- end
- Else If (AValues[I].Name = 'LYRIC') then
- begin
- Lyric := AValues[I].Value;
-
- If (Length(Lyric) > 0) then
- begin
- If (Lyric = '-') then
- Lyric[1] := Settings.DashReplacement;
-
- If (not BindLyrics) then
- Lyric := ' ' + Lyric;
-
-
- If (Length(Lyric) > 2) AND (Lyric[Length(Lyric)-1] = ' ') AND (Lyric[Length(Lyric)] = '-') then
- begin //Between this and the next Lyric should be no space
- BindLyrics := True;
- SetLength(Lyric, Length(Lyric) - 2);
- end
- else
- BindLyrics := False; //There should be a Space
- end;
- end;
- end;
-
- //Add Note
- I := SongInfo.CountSentences - 1;
-
- If (Length(Lyric) > 0) then
- begin //Real note, no rest
- //First Note of Sentence
- If (Length(SongInfo.Sentences) < SongInfo.CountSentences) then
- begin
- SetLength(SongInfo.Sentences, SongInfo.CountSentences);
- SetLength(SongInfo.Sentences[I].Notes, 0);
- end;
-
- //First Note of Song -> Generate Gap
- If (FirstNote) then
- begin
- //Calculate Gap
- If (SongInfo.Header.Resolution <> 0) AND (SongInfo.Header.BPM <> 0) then
- SongInfo.Header.Gap := Round(CurPosinSong / (SongInfo.Header.BPM*SongInfo.Header.Resolution) * 60000)
- Else
- begin
- Result := False;
- ErrorMessage := 'Can''t calculate Gap, no Resolution or BPM present.';
- Exit;
- end;
-
- CurPosinSong := 0; //Start at 0, because Gap goes until here
- Inc(SongInfo.ID); //Add Header Value therefore Inc
- FirstNote := False;
- end;
-
- J := Length(SongInfo.Sentences[I].Notes);
- SetLength(SongInfo.Sentences[I].Notes, J + 1);
- SongInfo.Sentences[I].Notes[J].Start := CurPosinSong;
- SongInfo.Sentences[I].Notes[J].Duration := Duration;
- SongInfo.Sentences[I].Notes[J].Tone := Tone;
- SongInfo.Sentences[I].Notes[J].NoteTyp := NoteType;
- SongInfo.Sentences[I].Notes[J].Lyric := Lyric;
-
- //Inc Pos in Song
- Inc(CurPosInSong, Duration);
- end
- else
- begin
- //just change pos in Song
- Inc(CurPosInSong, Duration);
- end;
-
-
- end
- Else If (Tag = '/SENTENCE') then
- begin //End of Sentence Tag
- ParserState := PS_Melody;
-
- //Delete Sentence if no Note is Added
- If (Length(SongInfo.Sentences) <> SongInfo.CountSentences) then
- begin
- SongInfo.CountSentences := Length(SongInfo.Sentences);
- end;
- end;
- end;
- end;
-
- end
- else //Empty Line -> parsed succesful ;)
- Result := true;
-end;
-
-Function TParser.ParseConfigForEdition(const Filename: IPath): String;
-var
- txt: TStringlist;
- Stream: TBinaryFileStream;
- I: Integer;
- J, K: Integer;
- S: String;
-begin
- Result := '';
-
- Stream := TBinaryFileStream.Create(Filename, fmOpenRead);
- try
- txt := TStringlist.Create;
- txt.LoadFromStream(Stream);
- For I := 0 to txt.Count-1 do
- begin
- S := Trim(txt.Strings[I]);
- J := Pos('', S);
-
- If (J <> 0) then
- begin
- Inc(J, 14);
- K := Pos('', S);
- If (K 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
-// 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, //
- deAttList : (ElemDef : TElemDef); //
- deEntity : (EntityDef : TEntityDef); //
- deNotation : (NotationDef : TNotationDef); //
- dePI : (Target : PChar; //
- Content : PChar;
- AttrList : TAttrList);
- deError : (Pos : PChar); // Error
- // deComment : ((No additional fields here)); //
- 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 ';
-
- // --- 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 " 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 '' if successful
-BEGIN
- Result := FALSE;
- Clear;
- FBufferSize := StrLen (Buffer) + 1;
- TRY
- GetMem (FBuffer, FBufferSize);
- EXCEPT
- Clear;
- EXIT;
- END;
- StrCopy (FBuffer, Buffer);
- FSource := '';
- Result := TRUE;
-END;
-
-
-PROCEDURE TXmlParser.SetBuffer (Buffer : PChar); // References another buffer
-BEGIN
- Clear;
- FBuffer := Buffer;
- FBufferSize := 0;
- FSource := '';
-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, '');
- 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 ::= ''
- markupdecl ::= elementdecl | AttlistDecl | EntityDecl | NotationDecl | PI | Comment
- PEReference ::= '%' Name ';'
-
- elementdecl ::= ''
- AttlistDecl ::= ''
- EntityDecl ::= '' |
- ''
- NotationDecl ::= ''
- PI ::= '' PITarget (S (Char* - (Char* '?>' Char* )))? '?>'
- Comment ::= '' *)
-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 '' : 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, ' 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, '');
-
- // --- 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 ' character
- XmlSpec 3.2:
- elementdecl ::= ''
- 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 ' character
- XmlSpec 3.3:
- AttlistDecl ::= ''
- 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:
- *)
-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 ' : 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 ' character
- XmlSpec 4.2:
- EntityDecl ::= '' |
- ''
- EntityDef ::= EntityValue | (ExternalID NDataDecl?)
- PEDef ::= EntityValue | ExternalID
- NDataDecl ::= S 'NDATA' S Name
- EntityValue ::= '"' ([^%&"] | PEReference | EntityRef | CharRef)* '"' |
- "'" ([^%&'] | PEReference | EntityRef | CharRef)* "'"
- PEReference ::= '%' Name ';'
-
- Examples
-
-
-
- ">
-
-
- Dies ist ein Test-Absatz
">
- *)
-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 ' : 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 ' character
- // XmlSpec 4.7: NotationDecl ::= ''
-TYPE
- TPhase = (phName, phExtId, phEnd);
-VAR
- ExternalID : TExternalID;
- Phase : TPhase;
- F : PChar;
- NotationDef : TNotationDef;
- DER : TDtdElementRec;
-BEGIN
- Final := Start + 10; // Character after ',
- #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
-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
-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
-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
-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
-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 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 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 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 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 }
-{ }
-{ 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 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 }
-{ }
-{ 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 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 }
-{ }
-{ Portions created by Dominique Louis are }
-{ Copyright (C) 2000 - 2004 Dominique Louis. }
-{ }
-{ }
-{ Contributor(s) }
-{ -------------- }
-{ Tom Jones His Project inspired this conversion }
-{ Matthias Thoma }
-{ }
-{ 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< }
-
- { 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] ) ... 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 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 }
-{ }
-{ 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 }
-{ }
-{ 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 }
-{ }
-{ Portions created by Tom Jones are }
-{ Copyright (C) 2000 - 2001 Tom Jones. }
-{ }
-{ }
-{ Contributor(s) }
-{ -------------- }
-{ Dominique Louis }
-{ Róbert Kisnémeth }
-{ }
-{ 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 }
-{ }
-{ Portions created by Dominique Louis are }
-{ Copyright (C) 2003 - 2100 Dominique Louis. }
-{ }
-{ }
-{ Contributor(s) }
-{ -------------- }
-{ Dominique Louis }
-{ }
-{ 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" }
-{ }
-{******************************************************************}
-{
- $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 }
-{ }
-{ Portions created by Dominique Louis are }
-{ Copyright (C) 2004 - 2100 Dominique Louis. }
-{ }
-{ }
-{ Contributor(s) }
-{ -------------- }
-{ Dominique Louis }
-{ }
-{ 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 }
-{ }
-{ Portions created by Tom Jones are }
-{ Copyright (C) 2000 - 2001 Tom Jones. }
-{ }
-{ }
-{ Contributor(s) }
-{ -------------- }
-{ Dominique Louis }
-{ Róbert Kisnémeth }
-{ }
-{ 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 }
-{ }
-{ Portions created by Dominique Louis are }
-{ Copyright (C) 2004 - 2100 Dominique Louis. }
-{ }
-{ }
-{ Contributor(s) }
-{ -------------- }
-{ Dominique Louis }
-{ }
-{ 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 }
-{ }
-{ 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 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 }
-{ }
-{ Portions created by Matthias Thoma are }
-{ Copyright (C) 2000 - 2001 Matthias Thoma. }
-{ }
-{ }
-{ Contributor(s) }
-{ -------------- }
-{ Dominique Louis }
-{ }
-{ 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.
- * 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, 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, 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
- * x 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
- * /, 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
- *
- * 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
- *
- * 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
- *
- * 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
- *
- * 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= 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
- *
- * 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
- (*************************************************************************)
- (* *)
- (* *)
- (* FT_Library *)
- (* *)
- (* *)
- (* 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). *)
- (* *)
- (* *)
- (* Library objects are normally created by @FT_Init_FreeType, and *)
- (* destroyed with @FT_Done_FreeType. *)
- (* *)
- FT_Library = Pointer;
-
-
- (*************************************************************************)
- (* *)
- (* *)
- (* FT_FACE_FLAG_XXX *)
- (* *)
- (* *)
- (* 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. *)
- (* *)
- (* *)
- (* 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;
-
- (*************************************************************************)
- (* *)
- (* *)
- (* FT_Encoding *)
- (* *)
- (* *)
- (* An enumeration used to specify encodings supported by charmaps. *)
- (* Used in the @FT_Select_Charmap API function. *)
- (* *)
- (* *)
- (* 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. *)
- (* *)
- (* *)
- (* 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. *)
- (* *)
- (* *)
- (* 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');
-
-
- (*************************************************************************)
- (* *)
- (* *)
- (* FT_STYLE_FLAG_XXX *)
- (* *)
- (* *)
- (* 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. *)
- (* *)
- (* *)
- (* 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;
-
- (*************************************************************************)
- (* *)
- (* *)
- (* FT_Render_Mode *)
- (* *)
- (* *)
- (* 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. *)
- (* *)
- (* *)
- (* 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. *)
- (* *)
- (* *)
- (* 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;
-
-
- (*************************************************************************)
- (* *)
- (* *)
- (* FT_GlyphSlot *)
- (* *)
- (* *)
- (* 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. *)
- (* *)
- (* *)
- (* @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}
-
-
- (*************************************************************************)
- (* *)
- (* *)
- (* FT_Glyph_Metrics *)
- (* *)
- (* *)
- (* 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. *)
- (* *)
- (* *)
- (* 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;
-
-
- (*************************************************************************)
- (* *)
- (* *)
- (* FT_Bitmap_Size *)
- (* *)
- (* *)
- (* 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. *)
- (* *)
- (* *)
- (* 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. *)
- (* *)
- (* *)
- (* 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;
-
-
- (*************************************************************************)
- (* *)
- (* *)
- (* FT_Face *)
- (* *)
- (* *)
- (* A handle to a given typographic face object. A face object models *)
- (* a given typeface, in a given style. *)
- (* *)
- (* *)
- (* 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). *)
- (* *)
- (* *)
- (* The @FT_FaceRec details the publicly accessible fields of a given *)
- (* face object. *)
- (* *)
- FT_Face = ^FT_FaceRec;
-
- (*************************************************************************)
- (* *)
- (* *)
- (* FT_CharMap *)
- (* *)
- (* *)
- (* 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. *)
- (* *)
- (* *)
- (* 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. *)
- (* *)
- (* *)
- (* 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;
-
-
-
-
-
-
-
- (*************************************************************************)
- (* *)
- (* *)
- (* FT_SubGlyph *)
- (* *)
- (* *)
- (* The subglyph structure is an internal object used to describe *)
- (* subglyphs (for example, in the case of composites). *)
- (* *)
- (* *)
- (* 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;
-
-
- (*************************************************************************)
- (* *)
- (* *)
- (* FT_GlyphSlotRec *)
- (* *)
- (* *)
- (* FreeType root glyph slot class structure. A glyph slot is a *)
- (* container where individual glyphs can be loaded, be they *)
- (* vectorial or bitmap/graymaps. *)
- (* *)
- (* *)
- (* 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. *)
- (* *)
- (* *)
- (* 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' . *)
- (* *)
- (* *)
- (* 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 *)
- (* *)
- (* *)
- (* *)
- (* *)
- (* 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; *)
- (* *)
- (* *)
- (* *)
- (* 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;
-
- (*************************************************************************)
- (* *)
- (* *)
- (* FT_Size_Metrics *)
- (* *)
- (* *)
- (* The size metrics structure returned scaled important distances for *)
- (* a given size object. *)
- (* *)
- (* *)
- (* 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. *)
- (* *)
- (* *)
- (* 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;
-
- (*************************************************************************)
- (* *)
- (* *)
- (* FT_Size *)
- (* *)
- (* *)
- (* 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. *)
- (* *)
- (* *)
- (* 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. *)
- (* *)
- (* *)
- (* The @FT_SizeRec structure details the publicly accessible fields *)
- (* of a given face object. *)
- (* *)
- FT_Size = ^FT_SizeRec;
-
- (*************************************************************************)
- (* *)
- (* *)
- (* FT_SizeRec *)
- (* *)
- (* *)
- (* FreeType root size class structure. A size object models the *)
- (* resolution and pointsize dependent data of a given face. *)
- (* *)
- (* *)
- (* 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;
-
-
- (*************************************************************************)
- (* *)
- (* *)
- (* FT_FaceRec *)
- (* *)
- (* *)
- (* FreeType root face class structure. A face object models the *)
- (* resolution and point-size independent data found in a font file. *)
- (* *)
- (* *)
- (* 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;
-
-
- (*************************************************************************)
- (* *)
- (* *)
- (* FT_CharMapRec *)
- (* *)
- (* *)
- (* The base charmap structure. *)
- (* *)
- (* *)
- (* 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;
-
-
- (*************************************************************************)
- (* *)
- (* *)
- (* FT_Init_FreeType *)
- (* *)
- (* *)
- (* Initializes a new FreeType library object. The set of modules *)
- (* that are registered by this function is determined at build time. *)
- (* *)
- (*