Skip to content

Instantly share code, notes, and snippets.

@jarroddavis68

jarroddavis68/PiroGameToolkit.pas

Created November 18, 2021 19:43
Show Gist options
  • Save jarroddavis68/50dd58df5dd1d9727c7435c3038e074e to your computer and use it in GitHub Desktop.
Save jarroddavis68/50dd58df5dd1d9727c7435c3038e074e to your computer and use it in GitHub Desktop.
Download ZIP
Piro Game Toolkit Import Unit
Raw
PiroGameToolkit.pas
{==============================================================================
_____
___________(_)____________
___ __ \_ /__ ___/ __ \
__ /_/ / / _ / / /_/ /
_ .___//_/ /_/ \____/
/_/ Game Toolkit™
Copyright © 2021 tinyBigGAMES™ LLC
All Rights Reserved.
Website: https://tinybiggames.com
Email : [email protected]
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
3. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in
the documentation and/or other materials provided with the
distribution.
4. Neither the name of the copyright holder nor the names of its
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
5. All video, audio, graphics and other content accessed through the
software in this distro is the property of the applicable content owner
and may be protected by applicable copyright law. This License gives
Customer no rights to such content, and Company disclaims any liability
for misuse of content.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.
----------------------------------------------------------------------------
Release 1.0.pre-alpha1:
Initial Release
============================================================================= }
{$Z4}
{$A8}
{$INLINE AUTO}
unit PiroGameToolkit;
interface
uses
System.SysUtils,
System.Classes;
const
{$IF Defined(WIN64)}
PGT_DLL_NAME = 'PGT.dll';
{$ELSE}
{$MESSAGE Error 'Unsupported platform'}
{$ENDIF}
{ --- COMMON ---------------------------------------------------------------- }
type
{ THAlign }
THAlign = (haLeft, haCenter, haRight);
{ TVAlign }
TVAlign = (vaTop, vaCenter, vaBottom);
{ --- BASE ------------------------------------------------------------------ }
type
{ TBaseObject }
TBaseObject = class(TObject)
public
constructor Create; virtual;
destructor Destroy; override;
end;
{ IBaseInterface }
IBaseInterface = interface
['{29D01AA3-E370-4EB0-B258-FB9D17BB090A}']
end;
{ TBaseInterface }
TBaseInterface = class(TNoRefCountObject, IBaseInterface)
public
constructor Create; virtual;
destructor Destroy; override;
end;
{ TBaseInterfaceClass }
TBaseInterfaceClass = class of TBaseInterface;
{ --- CMDLINE --------------------------------------------------------------- }
{ ICmdLine }
ICmdLine = interface(IBaseInterface)
['{37A75CAC-3FE3-49FA-928B-BCA9A4CC9CB6}']
procedure Reset;
function ParamCount: Integer;
procedure ClearParams;
procedure AddAParam(const aParam: WideString);
procedure AddParams(const aParams: WideString);
function ParamStr(aIndex: Integer): WideString;
function GetParamValue(const aParamName: WideString; var aValue: WideString): Boolean;
function GetParam(const aParamName: WideString): Boolean;
end;
{ --- MATH ------------------------------------------------------------------ }
const
// Degree/Radian conversion
RAD2DEG = 180.0 / PI;
DEG2RAD = PI / 180.0;
{ Misc }
EPSILON = 0.00001;
type
{ TPointi }
PPointi = ^TPointi;
TPointi = record
X, Y: Integer;
end;
{ TPoint }
PPointf = ^TPointi;
TPointf = record
X, Y: Single;
end;
{ TRange }
PRange = ^TRange;
TRange = record
MinX, MinY, MaxX, MaxY: Single;
end;
{ TVector }
PVector = ^TVector;
TVector = record
X,Y,Z: Single;
constructor Create(aX: Single; aY: Single);
procedure Assign(aX: Single; aY: Single); overload; inline;
procedure Assign(aX: Single; aY: Single; aZ: Single); overload; inline;
procedure Assign(aVector: TVector); overload; inline;
procedure Clear; inline;
procedure Add(aVector: TVector); inline;
procedure Subtract(aVector: TVector); inline;
procedure Multiply(aVector: TVector); inline;
procedure Divide(aVector: TVector); inline;
function Magnitude: Single; inline;
function MagnitudeTruncate(aMaxMagitude: Single): TVector; inline;
function Distance(aVector: TVector): Single; inline;
procedure Normalize; inline;
function Angle(aVector: TVector): Single; inline;
procedure Thrust(aAngle: Single; aSpeed: Single); inline;
function MagnitudeSquared: Single; inline;
function DotProduct(aVector: TVector): Single; inline;
procedure Scale(aValue: Single); inline;
procedure DivideBy(aValue: Single); inline;
function Project(aVector: TVector): TVector; inline;
procedure Negate; inline;
end;
{ TRectangle }
PRectangle = ^TRectangle;
TRectangle = record
X, Y, Width, Height: Single;
constructor Create(aX: Single; aY: Single; aWidth: Single; aHeight: Single);
procedure Assign(aX: Single; aY: Single; aWidth: Single; aHeight: Single); inline;
function Intersect(aRect: TRectangle): Boolean; inline;
end;
{ IMath }
IMath = interface(IBaseInterface)
['{8D638D5E-9077-49D7-9254-1F2906380C4A}']
procedure Randomize;
function RandomRange(aMin, aMax: Integer): Integer; overload;
function RandomRange(aMin, aMax: Single): Single; overload;
function RandomBool: Boolean;
function GetRandomSeed: Integer;
procedure SetRandomSeed(aValue: Integer);
function AngleCos(aAngle: Integer): Single;
function AngleSin(aAngle: Integer): Single;
function AngleDifference(aSrcAngle: Single; aDestAngle: Single): Single;
procedure AngleRotatePos(aAngle: Single; var aX: Single; var aY: Single);
function ClipValue(var aValue: Single; aMin: Single; aMax: Single; aWrap: Boolean): Single; overload;
function ClipValue(var aValue: Integer; aMin: Integer; aMax: Integer; aWrap: Boolean): Integer; overload;
function SameSign(aValue1: Integer; aValue2: Integer): Boolean; overload;
function SameSign(aValue1: Single; aValue2: Single): Boolean; overload;
function SameValue(aA: Double; aB: Double; aEpsilon: Double = 0): Boolean; overload;
function SameValue(aA: Single; aB: Single; aEpsilon: Single = 0): Boolean; overload;
function Point(aX: Integer; aY: Integer): TPointi; overload;
function Point(aX: Single; aY: Single): TPointf; overload;
function Vector(aX: Single; aY: Single): TVector;
function Rectangle(aX: Single; aY: Single; aWidth: Single; aHeight: Single): TRectangle;
procedure SmoothMove(var aValue: Single; aAmount: Single; aMax: Single; aDrag: Single);
function Lerp(aFrom: Double; aTo: Double; aTime: Double): Double;
end;
{ --- EASING ---------------------------------------------------------------- }
type
{ TEaseType }
TEaseType = (etLinearTween, etInQuad, etOutQuad, etInOutQuad, etInCubic,
etOutCubic, etInOutCubic, etInQuart, etOutQuart, etInOutQuart, etInQuint,
etOutQuint, etInOutQuint, etInSine, etOutSine, etInOutSine, etInExpo,
etOutExpo, etInOutExpo, etInCircle, etOutCircle, etInOutCircle);
{ IEase }
IEase = interface(IBaseInterface)
['{229BCCFE-DA63-465C-A7E0-DBA072659E94}']
function Value(aCurrentTime: Double; aStartValue: Double; aChangeInValue: Double; aDuration: Double; aEaseType: TEaseType): Double;
function Position(aStartPos: Double; aEndPos: Double; aCurrentPos: Double; aEaseType: TEaseType): Double;
end;
{ --- COLLISION ------------------------------------------------------------- }
type
{ TLineIntersection }
TLineIntersection = (liNone, liTrue, liParallel);
{ ICollision }
ICollision = interface(IBaseInterface)
['{2160B444-5728-4902-8A50-98BFA7EE4E43}']
function PointInRectangle(aPoint: TVector; aRect: TRectangle): Boolean;
function PointInCircle(aPoint, aCenter: TVector; aRadius: Single): Boolean;
function PointInTriangle(aPoint, aP1, aP2, aP3: TVector): Boolean;
function CirclesOverlap(aCenter1: TVector; aRadius1: Single; aCenter2: TVector; aRadius2: Single): Boolean;
function CircleInRectangle(aCenter: TVector; aRadius: Single; aRect: TRectangle): Boolean;
function RectanglesOverlap(aRect1: TRectangle; aRect2: TRectangle): Boolean;
function RectangleIntersection(aRect1, aRect2: TRectangle): TRectangle;
function LineIntersection(aX1, aY1, aX2, aY2, aX3, aY3, aX4, aY4: Integer; var aX: Integer; var aY: Integer): TLineIntersection;
function RadiusOverlap(aRadius1, aX1, aY1, aRadius2, aX2, aY2, aShrinkFactor: Single): Boolean;
end;
{ --- ARCHIVE --------------------------------------------------------------- }
type
{ TArchiveProgressEvent }
TArchiveProgressEvent = procedure(aSender: Pointer; const aFilename: WideString; aProgress: Integer; aNewFilename: Boolean);
{ IArchive }
IArchive = interface(IBaseInterface)
['{7BF65FE7-39E2-4F17-B1DF-813BE47AD6B9}']
function Open(const aPassword: WideString; const aFilename: WideString): Boolean;
function OpenRes(aInstance: NativeUInt; const aPassword: WideString; const aResName: WideString): Boolean;
procedure Close;
function IsOpen: Boolean;
function FileExist(const aFilename: WideString; var aFullPath: WideString): Boolean;
function Build(const aPassword: WideString; const aArchiveFilename: WideString; const aDirectoryName: WideString; aSender: Pointer; aHandler: TArchiveProgressEvent): Boolean;
end;
{ --- ARCHIVER -------------------------------------------------------------- }
type
{ IArchiver }
IArchiver = interface(IBaseInterface)
['{6D43A277-53F0-4098-9C14-0E0581BE6EC3}']
procedure Run;
end;
{ --- CONFIGFILE ------------------------------------------------------------ }
type
{ IConfigFile }
IConfigFile = interface(IBaseInterface)
['{1ACE4E8D-A5F6-418D-A18C-861A35A18DAB}']
function Open(const aFilename: WideString=''): Boolean;
procedure Close;
function IsOpen: Boolean;
procedure Update;
function RemoveSection(const aName: WideString): Boolean;
procedure SetValue(const aSection: WideString; const aKey: WideString; const aValue: WideString); overload;
procedure SetValue(const aSection: WideString; const aKey: WideString; aValue: Integer); overload;
procedure SetValue(const aSection: WideString; const aKey: WideString; aValue: Boolean); overload;
function GetValue(const aSection: WideString; const aKey: WideString; const aDefaultValue: WideString): WideString; overload;
function GetValue(const aSection: WideString; const aKey: WideString; aDefaultValue: Integer): Integer; overload;
function GetValue(const aSection: WideString; const aKey: WideString; aDefaultValue: Boolean): Boolean; overload;
function RemoveKey(const aSection: WideString; const aKey: WideString): Boolean;
function GetSectionValues(const aSection: WideString): Integer;
function GetSectionValue(aIndex: Integer; aDefaultValue: WideString): WideString; overload;
function GetSectionValue(aIndex: Integer; aDefaultValue: Integer): Integer; overload;
function GetSectionValue(aIndex: Integer; aDefaultValue: Boolean): Boolean; overload;
end;
{ --- AUDIO ----------------------------------------------------------------- }
const
AUDIO_BUFFER_COUNT = 256;
AUDIO_CHANNEL_COUNT = 16;
AUDIO_DYNAMIC_CHANNEL = -1;
AUDIO_INVALID_INDEX = -2;
type
{ TAudioStatus }
TAudioStatus = (asStopped, asPaused, asPlaying);
{ IAudio }
IAudio = interface(IBaseInterface)
['{AC656341-8A58-4778-9F3B-97578B0122EC}']
procedure Reset;
procedure Pause(aPause: Boolean);
function LoadMusic(aArchive: IArchive; const aFilename: string): Integer;
procedure UnloadMusic(var aMusic: Integer);
procedure UnloadAllMusic;
procedure PlayMusic(aMusic: Integer; aVolume: Single; aLoop: Boolean);
procedure StopMusic(aMusic: Integer);
procedure PauseMusic(aMusic: Integer);
procedure PauseAllMusic(aPause: Boolean);
procedure SetMusicLoop(aMusic: Integer; aLoop: Boolean);
function GetMusicLoop(aMusic: Integer): Boolean;
procedure SetMusicVolume(aMusic: Integer; aVolume: Single);
function GetMusicVolume(aMusic: Integer): Single;
function GetMusicStatus(aMusic: Integer): TAudioStatus;
procedure SetMusicOffset(aMusic: Integer; aSeconds: Single);
function LoadSound(aArchive: IArchive; const aFilename: string): Integer;
procedure UnloadSound(aSound: Integer);
function PlaySound(aChannel: Integer; aSound: Integer; aVolume: Single; aLoop: Boolean): Integer;
procedure SetChannelReserved(aChannel: Integer; aReserve: Boolean);
function GetChannelReserved(aChannel: Integer): Boolean;
procedure PauseChannel(aChannel: Integer; aPause: Boolean);
function GetChannelStatus(aChannel: Integer): TAudioStatus;
procedure SetChannelVolume(aChannel: Integer; aVolume: Single);
function GetChannelVolume(aChannel: Integer): Single;
procedure SetChannelLoop(aChannel: Integer; aLoop: Boolean);
function GetChannelLoop(aChannel: Integer): Boolean;
procedure SetChannelPitch(aChannel: Integer; aPitch: Single);
function GetChannelPitch(aChannel: Integer): Single;
procedure SetChannelPosition(aChannel: Integer; aX: Single; aY: Single);
procedure GetChannelPosition(aChannel: Integer; var aX: Single; var aY: Single);
procedure SetChannelMinDistance(aChannel: Integer; aDistance: Single);
function GetChannelMinDistance(aChannel: Integer): Single;
procedure SetChannelRelativeToListener(aChannel: Integer; aRelative: Boolean);
function GetChannelRelativeToListener(aChannel: Integer): Boolean;
procedure SetChannelAttenuation(aChannel: Integer; aAttenuation: Single);
function GetChannelAttenuation(aChannel: Integer): Single;
procedure StopChannel(aChannel: Integer);
procedure StopAllChannels;
procedure SetListenerGlobalVolume(aVolume: Single);
function GetListenerGlobalVolume: Single;
procedure SetListenerPosition(aX: Single; aY: Single);
procedure GetListenerPosition(var aX: Single; var aY: Single);
end;
{ --- COLOR ----------------------------------------------------------------- }
type
{ TColor }
PColor = ^TColor;
TColor = record
Red, Green, Blue, Alpha: Single;
end;
{ IColor }
IColor = interface(IBaseInterface)
['{ADC4FE09-016E-41BF-8B57-559C3926237C}']
function Make(aRed: Byte; aGreen: Byte; aBlue: Byte; aAlpha: Byte): TColor; overload;
function Make(aRed: Single; aGreen: Single; aBlue: Single; aAlpha: Single): TColor; overload;
function Make(const aName: WideString): TColor; overload;
function Fade(var aFrom: TColor; aTo: TColor; aPos: Single): TColor;
function Equal(aColor1: TColor; aColor2: TColor): Boolean;
end;
{$REGION 'Common Colors'}
const
ALICEBLUE : TColor = (Red:$F0/$FF; Green:$F8/$FF; Blue:$FF/$FF; Alpha:$FF/$FF);
ANTIQUEWHITE : TColor = (Red:$FA/$FF; Green:$EB/$FF; Blue:$D7/$FF; Alpha:$FF/$FF);
AQUA : TColor = (Red:$00/$FF; Green:$FF/$FF; Blue:$FF/$FF; Alpha:$FF/$FF);
AQUAMARINE : TColor = (Red:$7F/$FF; Green:$FF/$FF; Blue:$D4/$FF; Alpha:$FF/$FF);
AZURE : TColor = (Red:$F0/$FF; Green:$FF/$FF; Blue:$FF/$FF; Alpha:$FF/$FF);
BEIGE : TColor = (Red:$F5/$FF; Green:$F5/$FF; Blue:$DC/$FF; Alpha:$FF/$FF);
BISQUE : TColor = (Red:$FF/$FF; Green:$E4/$FF; Blue:$C4/$FF; Alpha:$FF/$FF);
BLACK : TColor = (Red:$00/$FF; Green:$00/$FF; Blue:$00/$FF; Alpha:$FF/$FF);
BLANCHEDALMOND : TColor = (Red:$FF/$FF; Green:$EB/$FF; Blue:$CD/$FF; Alpha:$FF/$FF);
BLUE : TColor = (Red:$00/$FF; Green:$00/$FF; Blue:$FF/$FF; Alpha:$FF/$FF);
BLUEVIOLET : TColor = (Red:$8A/$FF; Green:$2B/$FF; Blue:$E2/$FF; Alpha:$FF/$FF);
BROWN : TColor = (Red:$A5/$FF; Green:$2A/$FF; Blue:$2A/$FF; Alpha:$FF/$FF);
BURLYWOOD : TColor = (Red:$DE/$FF; Green:$B8/$FF; Blue:$87/$FF; Alpha:$FF/$FF);
CADETBLUE : TColor = (Red:$5F/$FF; Green:$9E/$FF; Blue:$A0/$FF; Alpha:$FF/$FF);
CHARTREUSE : TColor = (Red:$7F/$FF; Green:$FF/$FF; Blue:$00/$FF; Alpha:$FF/$FF);
CHOCOLATE : TColor = (Red:$D2/$FF; Green:$69/$FF; Blue:$1E/$FF; Alpha:$FF/$FF);
CORAL : TColor = (Red:$FF/$FF; Green:$7F/$FF; Blue:$50/$FF; Alpha:$FF/$FF);
CORNFLOWERBLUE : TColor = (Red:$64/$FF; Green:$95/$FF; Blue:$ED/$FF; Alpha:$FF/$FF);
CORNSILK : TColor = (Red:$FF/$FF; Green:$F8/$FF; Blue:$DC/$FF; Alpha:$FF/$FF);
CRIMSON : TColor = (Red:$DC/$FF; Green:$14/$FF; Blue:$3C/$FF; Alpha:$FF/$FF);
CYAN : TColor = (Red:$00/$FF; Green:$FF/$FF; Blue:$FF/$FF; Alpha:$FF/$FF);
DARKBLUE : TColor = (Red:$00/$FF; Green:$00/$FF; Blue:$8B/$FF; Alpha:$FF/$FF);
DARKCYAN : TColor = (Red:$00/$FF; Green:$8B/$FF; Blue:$8B/$FF; Alpha:$FF/$FF);
DARKGOLDENROD : TColor = (Red:$B8/$FF; Green:$86/$FF; Blue:$0B/$FF; Alpha:$FF/$FF);
DARKGRAY : TColor = (Red:$A9/$FF; Green:$A9/$FF; Blue:$A9/$FF; Alpha:$FF/$FF);
DARKGREEN : TColor = (Red:$00/$FF; Green:$64/$FF; Blue:$00/$FF; Alpha:$FF/$FF);
DARKGREY : TColor = (Red:$A9/$FF; Green:$A9/$FF; Blue:$A9/$FF; Alpha:$FF/$FF);
DARKKHAKI : TColor = (Red:$BD/$FF; Green:$B7/$FF; Blue:$6B/$FF; Alpha:$FF/$FF);
DARKMAGENTA : TColor = (Red:$8B/$FF; Green:$00/$FF; Blue:$8B/$FF; Alpha:$FF/$FF);
DARKOLIVEGREEN : TColor = (Red:$55/$FF; Green:$6B/$FF; Blue:$2F/$FF; Alpha:$FF/$FF);
DARKORANGE : TColor = (Red:$FF/$FF; Green:$8C/$FF; Blue:$00/$FF; Alpha:$FF/$FF);
DARKORCHID : TColor = (Red:$99/$FF; Green:$32/$FF; Blue:$CC/$FF; Alpha:$FF/$FF);
DARKRED : TColor = (Red:$8B/$FF; Green:$00/$FF; Blue:$00/$FF; Alpha:$FF/$FF);
DARKSALMON : TColor = (Red:$E9/$FF; Green:$96/$FF; Blue:$7A/$FF; Alpha:$FF/$FF);
DARKSEAGREEN : TColor = (Red:$8F/$FF; Green:$BC/$FF; Blue:$8F/$FF; Alpha:$FF/$FF);
DARKSLATEBLUE : TColor = (Red:$48/$FF; Green:$3D/$FF; Blue:$8B/$FF; Alpha:$FF/$FF);
DARKSLATEGRAY : TColor = (Red:$2F/$FF; Green:$4F/$FF; Blue:$4F/$FF; Alpha:$FF/$FF);
DARKSLATEGREY : TColor = (Red:$2F/$FF; Green:$4F/$FF; Blue:$4F/$FF; Alpha:$FF/$FF);
DARKTURQUOISE : TColor = (Red:$00/$FF; Green:$CE/$FF; Blue:$D1/$FF; Alpha:$FF/$FF);
DARKVIOLET : TColor = (Red:$94/$FF; Green:$00/$FF; Blue:$D3/$FF; Alpha:$FF/$FF);
DEEPPINK : TColor = (Red:$FF/$FF; Green:$14/$FF; Blue:$93/$FF; Alpha:$FF/$FF);
DEEPSKYBLUE : TColor = (Red:$00/$FF; Green:$BF/$FF; Blue:$FF/$FF; Alpha:$FF/$FF);
DIMGRAY : TColor = (Red:$69/$FF; Green:$69/$FF; Blue:$69/$FF; Alpha:$FF/$FF);
DIMGREY : TColor = (Red:$69/$FF; Green:$69/$FF; Blue:$69/$FF; Alpha:$FF/$FF);
DODGERBLUE : TColor = (Red:$1E/$FF; Green:$90/$FF; Blue:$FF/$FF; Alpha:$FF/$FF);
FIREBRICK : TColor = (Red:$B2/$FF; Green:$22/$FF; Blue:$22/$FF; Alpha:$FF/$FF);
FLORALWHITE : TColor = (Red:$FF/$FF; Green:$FA/$FF; Blue:$F0/$FF; Alpha:$FF/$FF);
FORESTGREEN : TColor = (Red:$22/$FF; Green:$8B/$FF; Blue:$22/$FF; Alpha:$FF/$FF);
FUCHSIA : TColor = (Red:$FF/$FF; Green:$00/$FF; Blue:$FF/$FF; Alpha:$FF/$FF);
GAINSBORO : TColor = (Red:$DC/$FF; Green:$DC/$FF; Blue:$DC/$FF; Alpha:$FF/$FF);
GHOSTWHITE : TColor = (Red:$F8/$FF; Green:$F8/$FF; Blue:$FF/$FF; Alpha:$FF/$FF);
GOLD : TColor = (Red:$FF/$FF; Green:$D7/$FF; Blue:$00/$FF; Alpha:$FF/$FF);
GOLDENROD : TColor = (Red:$DA/$FF; Green:$A5/$FF; Blue:$20/$FF; Alpha:$FF/$FF);
GRAY : TColor = (Red:$80/$FF; Green:$80/$FF; Blue:$80/$FF; Alpha:$FF/$FF);
GREEN : TColor = (Red:$00/$FF; Green:$80/$FF; Blue:$00/$FF; Alpha:$FF/$FF);
GREENYELLOW : TColor = (Red:$AD/$FF; Green:$FF/$FF; Blue:$2F/$FF; Alpha:$FF/$FF);
GREY : TColor = (Red:$80/$FF; Green:$80/$FF; Blue:$80/$FF; Alpha:$FF/$FF);
HONEYDEW : TColor = (Red:$F0/$FF; Green:$FF/$FF; Blue:$F0/$FF; Alpha:$FF/$FF);
HOTPINK : TColor = (Red:$FF/$FF; Green:$69/$FF; Blue:$B4/$FF; Alpha:$FF/$FF);
INDIANRED : TColor = (Red:$CD/$FF; Green:$5C/$FF; Blue:$5C/$FF; Alpha:$FF/$FF);
INDIGO : TColor = (Red:$4B/$FF; Green:$00/$FF; Blue:$82/$FF; Alpha:$FF/$FF);
IVORY : TColor = (Red:$FF/$FF; Green:$FF/$FF; Blue:$F0/$FF; Alpha:$FF/$FF);
KHAKI : TColor = (Red:$F0/$FF; Green:$E6/$FF; Blue:$8C/$FF; Alpha:$FF/$FF);
LAVENDER : TColor = (Red:$E6/$FF; Green:$E6/$FF; Blue:$FA/$FF; Alpha:$FF/$FF);
LAVENDERBLUSH : TColor = (Red:$FF/$FF; Green:$F0/$FF; Blue:$F5/$FF; Alpha:$FF/$FF);
LAWNGREEN : TColor = (Red:$7C/$FF; Green:$FC/$FF; Blue:$00/$FF; Alpha:$FF/$FF);
LEMONCHIFFON : TColor = (Red:$FF/$FF; Green:$FA/$FF; Blue:$CD/$FF; Alpha:$FF/$FF);
LIGHTBLUE : TColor = (Red:$AD/$FF; Green:$D8/$FF; Blue:$E6/$FF; Alpha:$FF/$FF);
LIGHTCORAL : TColor = (Red:$F0/$FF; Green:$80/$FF; Blue:$80/$FF; Alpha:$FF/$FF);
LIGHTCYAN : TColor = (Red:$E0/$FF; Green:$FF/$FF; Blue:$FF/$FF; Alpha:$FF/$FF);
LIGHTGOLDENRODYELLOW: TColor = (Red:$FA/$FF; Green:$FA/$FF; Blue:$D2/$FF; Alpha:$FF/$FF);
LIGHTGRAY : TColor = (Red:$D3/$FF; Green:$D3/$FF; Blue:$D3/$FF; Alpha:$FF/$FF);
LIGHTGREEN : TColor = (Red:$90/$FF; Green:$EE/$FF; Blue:$90/$FF; Alpha:$FF/$FF);
LIGHTGREY : TColor = (Red:$D3/$FF; Green:$D3/$FF; Blue:$D3/$FF; Alpha:$FF/$FF);
LIGHTPINK : TColor = (Red:$FF/$FF; Green:$B6/$FF; Blue:$C1/$FF; Alpha:$FF/$FF);
LIGHTSALMON : TColor = (Red:$FF/$FF; Green:$A0/$FF; Blue:$7A/$FF; Alpha:$FF/$FF);
LIGHTSEAGREEN : TColor = (Red:$20/$FF; Green:$B2/$FF; Blue:$AA/$FF; Alpha:$FF/$FF);
LIGHTSKYBLUE : TColor = (Red:$87/$FF; Green:$CE/$FF; Blue:$FA/$FF; Alpha:$FF/$FF);
LIGHTSLATEGRAY : TColor = (Red:$77/$FF; Green:$88/$FF; Blue:$99/$FF; Alpha:$FF/$FF);
LIGHTSLATEGREY : TColor = (Red:$77/$FF; Green:$88/$FF; Blue:$99/$FF; Alpha:$FF/$FF);
LIGHTSTEELBLUE : TColor = (Red:$B0/$FF; Green:$C4/$FF; Blue:$DE/$FF; Alpha:$FF/$FF);
LIGHTYELLOW : TColor = (Red:$FF/$FF; Green:$FF/$FF; Blue:$E0/$FF; Alpha:$FF/$FF);
LIME : TColor = (Red:$00/$FF; Green:$FF/$FF; Blue:$00/$FF; Alpha:$FF/$FF);
LIMEGREEN : TColor = (Red:$32/$FF; Green:$CD/$FF; Blue:$32/$FF; Alpha:$FF/$FF);
LINEN : TColor = (Red:$FA/$FF; Green:$F0/$FF; Blue:$E6/$FF; Alpha:$FF/$FF);
MAGENTA : TColor = (Red:$FF/$FF; Green:$00/$FF; Blue:$FF/$FF; Alpha:$FF/$FF);
MAROON : TColor = (Red:$80/$FF; Green:$00/$FF; Blue:$00/$FF; Alpha:$FF/$FF);
MEDIUMAQUAMARINE : TColor = (Red:$66/$FF; Green:$CD/$FF; Blue:$AA/$FF; Alpha:$FF/$FF);
MEDIUMBLUE : TColor = (Red:$00/$FF; Green:$00/$FF; Blue:$CD/$FF; Alpha:$FF/$FF);
MEDIUMORCHID : TColor = (Red:$BA/$FF; Green:$55/$FF; Blue:$D3/$FF; Alpha:$FF/$FF);
MEDIUMPURPLE : TColor = (Red:$93/$FF; Green:$70/$FF; Blue:$DB/$FF; Alpha:$FF/$FF);
MEDIUMSEAGREEN : TColor = (Red:$3C/$FF; Green:$B3/$FF; Blue:$71/$FF; Alpha:$FF/$FF);
MEDIUMSLATEBLUE : TColor = (Red:$7B/$FF; Green:$68/$FF; Blue:$EE/$FF; Alpha:$FF/$FF);
MEDIUMSPRINGGREEN : TColor = (Red:$00/$FF; Green:$FA/$FF; Blue:$9A/$FF; Alpha:$FF/$FF);
MEDIUMTURQUOISE : TColor = (Red:$48/$FF; Green:$D1/$FF; Blue:$CC/$FF; Alpha:$FF/$FF);
MEDIUMVIOLETRED : TColor = (Red:$C7/$FF; Green:$15/$FF; Blue:$85/$FF; Alpha:$FF/$FF);
MIDNIGHTBLUE : TColor = (Red:$19/$FF; Green:$19/$FF; Blue:$70/$FF; Alpha:$FF/$FF);
MINTCREAM : TColor = (Red:$F5/$FF; Green:$FF/$FF; Blue:$FA/$FF; Alpha:$FF/$FF);
MISTYROSE : TColor = (Red:$FF/$FF; Green:$E4/$FF; Blue:$E1/$FF; Alpha:$FF/$FF);
MOCCASIN : TColor = (Red:$FF/$FF; Green:$E4/$FF; Blue:$B5/$FF; Alpha:$FF/$FF);
NAVAJOWHITE : TColor = (Red:$FF/$FF; Green:$DE/$FF; Blue:$AD/$FF; Alpha:$FF/$FF);
NAVY : TColor = (Red:$00/$FF; Green:$00/$FF; Blue:$80/$FF; Alpha:$FF/$FF);
OLDLACE : TColor = (Red:$FD/$FF; Green:$F5/$FF; Blue:$E6/$FF; Alpha:$FF/$FF);
OLIVE : TColor = (Red:$80/$FF; Green:$80/$FF; Blue:$00/$FF; Alpha:$FF/$FF);
OLIVEDRAB : TColor = (Red:$6B/$FF; Green:$8E/$FF; Blue:$23/$FF; Alpha:$FF/$FF);
ORANGE : TColor = (Red:$FF/$FF; Green:$A5/$FF; Blue:$00/$FF; Alpha:$FF/$FF);
ORANGERED : TColor = (Red:$FF/$FF; Green:$45/$FF; Blue:$00/$FF; Alpha:$FF/$FF);
ORCHID : TColor = (Red:$DA/$FF; Green:$70/$FF; Blue:$D6/$FF; Alpha:$FF/$FF);
PALEGOLDENROD : TColor = (Red:$EE/$FF; Green:$E8/$FF; Blue:$AA/$FF; Alpha:$FF/$FF);
PALEGREEN : TColor = (Red:$98/$FF; Green:$FB/$FF; Blue:$98/$FF; Alpha:$FF/$FF);
PALETURQUOISE : TColor = (Red:$AF/$FF; Green:$EE/$FF; Blue:$EE/$FF; Alpha:$FF/$FF);
PALEVIOLETRED : TColor = (Red:$DB/$FF; Green:$70/$FF; Blue:$93/$FF; Alpha:$FF/$FF);
PAPAYAWHIP : TColor = (Red:$FF/$FF; Green:$EF/$FF; Blue:$D5/$FF; Alpha:$FF/$FF);
PEACHPUFF : TColor = (Red:$FF/$FF; Green:$DA/$FF; Blue:$B9/$FF; Alpha:$FF/$FF);
PERU : TColor = (Red:$CD/$FF; Green:$85/$FF; Blue:$3F/$FF; Alpha:$FF/$FF);
PINK : TColor = (Red:$FF/$FF; Green:$C0/$FF; Blue:$CB/$FF; Alpha:$FF/$FF);
PLUM : TColor = (Red:$DD/$FF; Green:$A0/$FF; Blue:$DD/$FF; Alpha:$FF/$FF);
POWDERBLUE : TColor = (Red:$B0/$FF; Green:$E0/$FF; Blue:$E6/$FF; Alpha:$FF/$FF);
PURPLE : TColor = (Red:$80/$FF; Green:$00/$FF; Blue:$80/$FF; Alpha:$FF/$FF);
REBECCAPURPLE : TColor = (Red:$66/$FF; Green:$33/$FF; Blue:$99/$FF; Alpha:$FF/$FF);
RED : TColor = (Red:$FF/$FF; Green:$00/$FF; Blue:$00/$FF; Alpha:$FF/$FF);
ROSYBROWN : TColor = (Red:$BC/$FF; Green:$8F/$FF; Blue:$8F/$FF; Alpha:$FF/$FF);
ROYALBLUE : TColor = (Red:$41/$FF; Green:$69/$FF; Blue:$E1/$FF; Alpha:$FF/$FF);
SADDLEBROWN : TColor = (Red:$8B/$FF; Green:$45/$FF; Blue:$13/$FF; Alpha:$FF/$FF);
SALMON : TColor = (Red:$FA/$FF; Green:$80/$FF; Blue:$72/$FF; Alpha:$FF/$FF);
SANDYBROWN : TColor = (Red:$F4/$FF; Green:$A4/$FF; Blue:$60/$FF; Alpha:$FF/$FF);
SEAGREEN : TColor = (Red:$2E/$FF; Green:$8B/$FF; Blue:$57/$FF; Alpha:$FF/$FF);
SEASHELL : TColor = (Red:$FF/$FF; Green:$F5/$FF; Blue:$EE/$FF; Alpha:$FF/$FF);
SIENNA : TColor = (Red:$A0/$FF; Green:$52/$FF; Blue:$2D/$FF; Alpha:$FF/$FF);
SILVER : TColor = (Red:$C0/$FF; Green:$C0/$FF; Blue:$C0/$FF; Alpha:$FF/$FF);
SKYBLUE : TColor = (Red:$87/$FF; Green:$CE/$FF; Blue:$EB/$FF; Alpha:$FF/$FF);
SLATEBLUE : TColor = (Red:$6A/$FF; Green:$5A/$FF; Blue:$CD/$FF; Alpha:$FF/$FF);
SLATEGRAY : TColor = (Red:$70/$FF; Green:$80/$FF; Blue:$90/$FF; Alpha:$FF/$FF);
SLATEGREY : TColor = (Red:$70/$FF; Green:$80/$FF; Blue:$90/$FF; Alpha:$FF/$FF);
SNOW : TColor = (Red:$FF/$FF; Green:$FA/$FF; Blue:$FA/$FF; Alpha:$FF/$FF);
SPRINGGREEN : TColor = (Red:$00/$FF; Green:$FF/$FF; Blue:$7F/$FF; Alpha:$FF/$FF);
STEELBLUE : TColor = (Red:$46/$FF; Green:$82/$FF; Blue:$B4/$FF; Alpha:$FF/$FF);
TAN : TColor = (Red:$D2/$FF; Green:$B4/$FF; Blue:$8C/$FF; Alpha:$FF/$FF);
TEAL : TColor = (Red:$00/$FF; Green:$80/$FF; Blue:$80/$FF; Alpha:$FF/$FF);
THISTLE : TColor = (Red:$D8/$FF; Green:$BF/$FF; Blue:$D8/$FF; Alpha:$FF/$FF);
TOMATO : TColor = (Red:$FF/$FF; Green:$63/$FF; Blue:$47/$FF; Alpha:$FF/$FF);
TURQUOISE : TColor = (Red:$40/$FF; Green:$E0/$FF; Blue:$D0/$FF; Alpha:$FF/$FF);
VIOLET : TColor = (Red:$EE/$FF; Green:$82/$FF; Blue:$EE/$FF; Alpha:$FF/$FF);
WHEAT : TColor = (Red:$F5/$FF; Green:$DE/$FF; Blue:$B3/$FF; Alpha:$FF/$FF);
WHITE : TColor = (Red:$FF/$FF; Green:$FF/$FF; Blue:$FF/$FF; Alpha:$FF/$FF);
WHITESMOKE : TColor = (Red:$F5/$FF; Green:$F5/$FF; Blue:$F5/$FF; Alpha:$FF/$FF);
YELLOW : TColor = (Red:$FF/$FF; Green:$FF/$FF; Blue:$00/$FF; Alpha:$FF/$FF);
YELLOWGREEN : TColor = (Red:$9A/$FF; Green:$CD/$FF; Blue:$32/$FF; Alpha:$FF/$FF);
BLANK : TColor = (Red:$00; Green:$00; Blue:$00; Alpha:$00);
WHITE2 : TColor = (Red:$F5/$FF; Green:$F5/$FF; Blue:$F5/$FF; Alpha:$FF/$FF);
RED22 : TColor = (Red:$7E/$FF; Green:$32/$FF; Blue:$3F/$FF; Alpha:255/$FF);
COLORKEY : TColor = (Red:$FF/$FF; Green:$00; Blue:$FF/$FF; Alpha:$FF/$FF);
OVERLAY1 : TColor = (Red:$00/$FF; Green:$20/$FF; Blue:$29/$FF; Alpha:$B4/$FF);
OVERLAY2 : TColor = (Red:$01/$FF; Green:$1B/$FF; Blue:$01/$FF; Alpha:255/$FF);
DIMWHITE : TColor = (Red:$10/$FF; Green:$10/$FF; Blue:$10/$FF; Alpha:$10/$FF);
{$ENDREGION}
{ --- BITMAP ---------------------------------------------------------------- }
type
{ TBitmapData }
PBitmapData = ^TBitmapData;
TBitmapData = record
Memory: Pointer;
Format: Integer;
Pitch: Integer;
PixelSize: Integer;
end;
{ IBitmap }
IBitmap = interface(IBaseInterface)
['{C095D05E-1699-47A8-954B-F53EEEF0492A}']
procedure Allocate(aWidth: Integer; aHeight: Integer);
procedure Load(aArchive: IArchive; const aFilename: WideString; aColorKey: PColor);
procedure Unload;
procedure GetSize(var aSize: TVector); overload;
procedure GetSize(aWidth: PSingle; aHeight: PSingle); overload;
procedure Lock(aRegion: PRectangle; aData: PBitmapData=nil);
procedure Unlock;
function GetPixel(aX: Integer; aY: Integer): TColor;
procedure PutPixel(aX: Integer; aY: Integer; aColor: TColor);
procedure Draw(aX, aY: Single; aRegion: PRectangle; aCenter: PVector; aScale: PVector; aAngle: Single; aColor: TColor; aHFlip: Boolean; aVFlip: Boolean); overload;
procedure Draw(aX, aY, aScale, aAngle: Single; aColor: TColor; aHAlign: THAlign; aVAlign: TVAlign; aHFlip: Boolean=False; aVFlip: Boolean=False); overload;
procedure DrawTiled(aDeltaX: Single; aDeltaY: Single);
end;
{ --- DISPLAY --------------------------------------------------------------- }
const
BLEND_ZERO = 0;
BLEND_ONE = 1;
BLEND_ALPHA = 2;
BLEND_INVERSE_ALPHA = 3;
BLEND_SRC_COLOR = 4;
BLEND_DEST_COLOR = 5;
BLEND_INVERSE_SRC_COLOR = 6;
BLEND_INVERSE_DEST_COLOR = 7;
BLEND_CONST_COLOR = 8;
BLEND_INVERSE_CONST_COLOR = 9;
BLEND_ADD = 0;
BLEND_SRC_MINUS_DEST = 1;
BLEND_DEST_MINUS_SRC = 2;
type
{ TBlendMode }
TBlendMode = (bmPreMultipliedAlpha, bmNonPreMultipliedAlpha, bmAdditiveAlpha, bmCopySrcToDest, bmMultiplySrcAndDest);
{ TBlendModeColor }
TBlendModeColor = (bcColorNormal, bcColorAvgSrcDest);
{ IDisplay }
IDisplay = interface(IBaseInterface)
['{84AB4719-9303-441C-9C03-84E4E42B6C33}']
function Open(aWidth: Integer; aHeight: Integer; const aTitle: WideString; aVSync: Boolean=True; aFullscreen: Boolean=False; aProgrammablePipeline: Boolean=False): Boolean;
function Close: Boolean;
function Opened: Boolean;
procedure ToggleFullscreen;
function GetFullscreen: Boolean;
procedure Clear(aColor: TColor);
procedure Show;
procedure ResetTransform;
procedure SetTransformPosition(aX: Integer; aY: Integer);
procedure SetTransformAngle(aAngle: Single);
procedure SetTarget(aBitmap: IBitmap);
procedure ResetTarget;
procedure GetSize(aWidth: PInteger; aHeight: PInteger; aAspectRatio: PSingle=nil);
procedure GetViewportSize(aX: PInteger; aY: PInteger; aWidth: PInteger; aHeight: PInteger); overload;
procedure GetViewportSize(var aSize: TRectangle); overload;
procedure DrawText(aX: Single; aY: Single; aColor: TColor; const aMsg: WideString; const aArgs: array of const);
procedure DrawLine(aX1, aY1, aX2, aY2: Single; aColor: TColor; aThickness: Single);
procedure DrawRectangle(aX, aY, aWidth, aHeight, aThickness: Single; aColor: TColor);
procedure DrawFilledRectangle(aX, aY, aWidth, aHeight: Single; aColor: TColor);
procedure DrawCircle(aX, aY, aRadius, aThickness: Single; aColor: TColor);
procedure DrawFilledCircle(aX, aY, aRadius: Single; aColor: TColor);
procedure DrawPolygon(aVertices: System.PSingle; aVertexCount: Integer; aThickness: Single; aColor: TColor);
procedure DrawFilledPolygon(aVertices: System.PSingle; aVertexCount: Integer; aColor: TColor);
procedure DrawTriangle(aX1, aY1, aX2, aY2, aX3, aY3, aThickness: Single; aColor: TColor);
procedure DrawFilledTriangle(aX1, aY1, aX2, aY2, aX3, aY3: Single; aColor: TColor);
procedure SetBlender(aOperation: Integer; aSource: Integer; aDestination: Integer);
procedure GetBlender(aOperation: PInteger; aSource: PInteger; aDestination: PInteger);
procedure SetBlendColor(aColor: TColor);
function GetBlendColor: TColor;
procedure SetBlendMode(aMode: TBlendMode);
procedure SetBlendModeColor(aMode: TBlendModeColor; aColor: TColor);
procedure RestoreDefaultBlendMode;
procedure Save(const aFilename: WideString);
end;
{ --- INPUT ----------------------------------------------------------------- }
const
MAX_AXES = 3;
MAX_STICKS = 16;
MAX_BUTTONS = 32;
MOUSE_BUTTON_LEFT = 1;
MOUSE_BUTTON_RIGHT = 2;
MOUSE_BUTTON_MIDDLE = 3;
{$REGION 'Keyboard Constants'}
const
// Keyboard Constants
KEY_A = 1;
KEY_B = 2;
KEY_C = 3;
KEY_D = 4;
KEY_E = 5;
KEY_F = 6;
KEY_G = 7;
KEY_H = 8;
KEY_I = 9;
KEY_J = 10;
KEY_K = 11;
KEY_L = 12;
KEY_M = 13;
KEY_N = 14;
KEY_O = 15;
KEY_P = 16;
KEY_Q = 17;
KEY_R = 18;
KEY_S = 19;
KEY_T = 20;
KEY_U = 21;
KEY_V = 22;
KEY_W = 23;
KEY_X = 24;
KEY_Y = 25;
KEY_Z = 26;
KEY_0 = 27;
KEY_1 = 28;
KEY_2 = 29;
KEY_3 = 30;
KEY_4 = 31;
KEY_5 = 32;
KEY_6 = 33;
KEY_7 = 34;
KEY_8 = 35;
KEY_9 = 36;
KEY_PAD_0 = 37;
KEY_PAD_1 = 38;
KEY_PAD_2 = 39;
KEY_PAD_3 = 40;
KEY_PAD_4 = 41;
KEY_PAD_5 = 42;
KEY_PAD_6 = 43;
KEY_PAD_7 = 44;
KEY_PAD_8 = 45;
KEY_PAD_9 = 46;
KEY_F1 = 47;
KEY_F2 = 48;
KEY_F3 = 49;
KEY_F4 = 50;
KEY_F5 = 51;
KEY_F6 = 52;
KEY_F7 = 53;
KEY_F8 = 54;
KEY_F9 = 55;
KEY_F10 = 56;
KEY_F11 = 57;
KEY_F12 = 58;
KEY_ESCAPE = 59;
KEY_TILDE = 60;
KEY_MINUS = 61;
KEY_EQUALS = 62;
KEY_BACKSPACE = 63;
KEY_TAB = 64;
KEY_OPENBRACE = 65;
KEY_CLOSEBRACE = 66;
KEY_ENTER = 67;
KEY_SEMICOLON = 68;
KEY_QUOTE = 69;
KEY_BACKSLASH = 70;
KEY_BACKSLASH2 = 71;
KEY_COMMA = 72;
KEY_FULLSTOP = 73;
KEY_SLASH = 74;
KEY_SPACE = 75;
KEY_INSERT = 76;
KEY_DELETE = 77;
KEY_HOME = 78;
KEY_END = 79;
KEY_PGUP = 80;
KEY_PGDN = 81;
KEY_LEFT = 82;
KEY_RIGHT = 83;
KEY_UP = 84;
KEY_DOWN = 85;
KEY_PAD_SLASH = 86;
KEY_PAD_ASTERISK = 87;
KEY_PAD_MINUS = 88;
KEY_PAD_PLUS = 89;
KEY_PAD_DELETE = 90;
KEY_PAD_ENTER = 91;
KEY_PRINTSCREEN = 92;
KEY_PAUSE = 93;
KEY_ABNT_C1 = 94;
KEY_YEN = 95;
KEY_KANA = 96;
KEY_CONVERT = 97;
KEY_NOCONVERT = 98;
KEY_AT = 99;
KEY_CIRCUMFLEX = 100;
KEY_COLON2 = 101;
KEY_KANJI = 102;
KEY_PAD_EQUALS = 103;
KEY_BACKQUOTE = 104;
KEY_SEMICOLON2 = 105;
KEY_COMMAND = 106;
KEY_BACK = 107;
KEY_VOLUME_UP = 108;
KEY_VOLUME_DOWN = 109;
KEY_SEARCH = 110;
KEY_DPAD_CENTER = 111;
KEY_BUTTON_X = 112;
KEY_BUTTON_Y = 113;
KEY_DPAD_UP = 114;
KEY_DPAD_DOWN = 115;
KEY_DPAD_LEFT = 116;
KEY_DPAD_RIGHT = 117;
KEY_SELECT = 118;
KEY_START = 119;
KEY_BUTTON_L1 = 120;
KEY_BUTTON_R1 = 121;
KEY_BUTTON_L2 = 122;
KEY_BUTTON_R2 = 123;
KEY_BUTTON_A = 124;
KEY_BUTTON_B = 125;
KEY_THUMBL = 126;
KEY_THUMBR = 127;
KEY_UNKNOWN = 128;
KEY_MODIFIERS = 215;
KEY_LSHIFT = 215;
KEY_RSHIFT = 216;
KEY_LCTRL = 217;
KEY_RCTRL = 218;
KEY_ALT = 219;
KEY_ALTGR = 220;
KEY_LWIN = 221;
KEY_RWIN = 222;
KEY_MENU = 223;
KEY_SCROLLLOCK = 224;
KEY_NUMLOCK = 225;
KEY_CAPSLOCK = 226;
KEY_MAX = 227;
KEYMOD_SHIFT = $0001;
KEYMOD_CTRL = $0002;
KEYMOD_ALT = $0004;
KEYMOD_LWIN = $0008;
KEYMOD_RWIN = $0010;
KEYMOD_MENU = $0020;
KEYMOD_COMMAND = $0040;
KEYMOD_SCROLOCK = $0100;
KEYMOD_NUMLOCK = $0200;
KEYMOD_CAPSLOCK = $0400;
KEYMOD_INALTSEQ = $0800;
KEYMOD_ACCENT1 = $1000;
KEYMOD_ACCENT2 = $2000;
KEYMOD_ACCENT3 = $4000;
KEYMOD_ACCENT4 = $8000;
{$ENDREGION}
var
// sticks
JOY_STICK_LS: Integer = 0;
JOY_STICK_RS: Integer = 1;
JOY_STICK_LT: Integer = 2;
JOY_STICK_RT: Integer = 3;
// axes
JOY_AXES_X: Integer = 0;
JOY_AXES_Y: Integer = 1;
JOY_AXES_Z: Integer = 2;
// buttons
JOY_BTN_A: Integer = 0;
JOY_BTN_B: Integer = 1;
JOY_BTN_X: Integer = 2;
JOY_BTN_Y: Integer = 3;
JOY_BTN_RB: Integer = 4;
JOY_BTN_LB: Integer = 5;
JOY_BTN_RT: Integer = 6;
JOY_BTN_LT: Integer = 7;
JOY_BTN_BACK: Integer = 8;
JOY_BTN_START: Integer = 9;
JOY_BTN_RDPAD: Integer = 10;
JOY_BTN_LDPAD: Integer = 11;
JOY_BTN_DDPAD: Integer = 12;
JOY_BTN_UDPAD: Integer = 13;
type
{ IInput }
IInput = interface(IBaseInterface)
['{570AE3F8-BAA5-4B5B-AB1B-D5819047C1A8}']
procedure Clear;
function KeyboardPressed(aKey: Integer): Boolean;
function KeyboardReleased(aKey: Integer): Boolean;
function KeyboardDown(aKey: Integer): Boolean;
function KeyboardGetPressed: Integer;
function MousePressed(aButton: Integer): Boolean;
function MouseReleased(aButton: Integer): Boolean;
function MouseDown(aButton: Integer): Boolean;
procedure MouseGetInfo(aX: PInteger; aY: PInteger; aWheel: PInteger); overload;
procedure MouseGetInfo(var aPos: TVector); overload;
procedure MouseSetPos(aX: Integer; aY: Integer);
procedure MouseShowCursor(aShow: Boolean);
function JoystickPressed(aButton: Integer): Boolean;
function JoystickReleased(aButton: Integer): Boolean;
function JoystickDown(aButton: Integer): Boolean;
function JoystickGetPos(aStick: Integer; aAxes: Integer): Single;
end;
{ --- FONT ------------------------------------------------------------------ }
type
{ IFont }
IFont = interface(IBaseInterface)
['{DFE1E64D-22EE-40B5-8D53-8E03F7993FD7}']
procedure Load(aSize: Cardinal); overload;
procedure Load(aSize: Cardinal; aArchive: IArchive; const aFilename: WideString); overload;
procedure Load(aSize: Cardinal; aMemory: Pointer; aLength: Int64); overload;
procedure Unload;
procedure Print(aX: Single; aY: Single; aColor: TColor; aAlign: THAlign; const aMsg: WideString; const aArgs: array of const); overload;
procedure Print(aX: Single; var aY: Single; aLineSpace: Single; aColor: TColor; aAlign: THAlign; const aMsg: WideString; const aArgs: array of const); overload;
procedure Print(aX: Single; aY: Single; aColor: TColor; aAngle: Single; const aMsg: WideString; const aArgs: array of const); overload;
function GetTextWidth(const aMsg: WideString; const aArgs: array of const): Single;
function GetLineHeight: Single;
end;
{ --- VIDEO ----------------------------------------------------------------- }
type
{ IVideo }
IVideo = interface(IBaseInterface)
['{281B93C6-8930-4CBB-900D-7FE3AFBA4700}']
procedure Load(aArchive: IArchive; const aFilename: WideString);
procedure Unload;
function GetPause: Boolean;
procedure SetPause(aPause: Boolean);
function GetLooping: Boolean;
procedure SetLooping(aLoop: Boolean);
function GetPlaying: Boolean;
procedure SetPlaying(aPlay: Boolean);
function GetFilename: WideString;
procedure Play(aArchive: IArchive; const aFilename: WideString; aLoop: Boolean; aGain: Single); overload;
procedure Play(aLoop: Boolean; aGain: Single); overload;
procedure Draw(aX: Single; aY: Single);
procedure GetSize(aWidth: PSingle; aHeight: PSingle);
procedure Seek(aPos: Single);
procedure Rewind;
end;
{ --- SCREENSHAKE ----------------------------------------------------------- }
type
{ IScreenshake }
IScreenshake = interface(IBaseInterface)
['{8CB6B14A-04DD-4369-8098-20F7F259CF7A}']
procedure Start(aDuration: Single; aMagnitude: Single);
procedure Clear;
function Active: Boolean;
end;
{ --- SCREENSHOT ------------------------------------------------------------ }
type
{ IScreenshot }
IScreenshot = interface(IBaseInterface)
['{DF625157-B63E-4E5E-A685-0A1B5BF5661E}']
procedure Init(const aDir: WideString; const aBaseFilename: WideString);
procedure Take;
end;
{ --- ASYNC ----------------------------------------------------------------- }
type
{ IAsync }
IAsync = interface(IBaseInterface)
['{42ECDE00-0D46-4409-8EAE-FA5DC0A2C0CA}']
procedure Run(aTask: TProc; aWait: TProc);
procedure Enter;
procedure Leave;
end;
{ --- SPEECH ---------------------------------------------------------------- }
type
{ TSpeechVoiceAttribute }
TSpeechVoiceAttribute = (vaDescription, vaName, vaVendor, vaAge, vaGender, vaLanguage, vaId);
{ ISpeech }
ISpeech = interface(IBaseInterface)
['{C1837D80-991E-4BAE-A1BC-E6C16ED3C0A4}']
function GetVoiceCount: Integer;
function GetVoiceAttribute(aIndex: Integer; aAttribute: TSpeechVoiceAttribute): WideString;
procedure ChangeVoice(aIndex: Integer);
function GetVoice: Integer;
procedure SetVolume(aVolume: Single);
function GetVolume: Single;
procedure SetRate(aRate: Single);
function GetRate: Single;
procedure Clear;
procedure Say(const aText: WideString; aPurge: Boolean);
procedure SayXML(const aText: WideString; aPurge: Boolean);
function Active: Boolean;
procedure Pause;
procedure Resume;
procedure Reset;
end;
{ --- STARFIELD ------------------------------------------------------------- }
type
{ IStarfield }
IStarfield = interface(IBaseInterface)
['{2FFAECF1-58D5-4491-843E-A5A0122464C4}']
procedure Init(aStarCount: Cardinal; aMinX, aMinY, aMinZ, aMaxX, aMaxY, aMaxZ, aViewScale: Single);
procedure SetVirtualPos(aX, aY: Single);
procedure GetVirtualPos(var aX: Single; var aY: Single);
procedure SetXSpeed(aSpeed: Single);
procedure SetYSpeed(aSpeed: Single);
procedure SetZSpeed(aSpeed: Single);
procedure Update(aDeltaTime: Single);
procedure Render;
end;
{ --- POLYGON --------------------------------------------------------------- }
type
{ IPolygon }
IPolygon = interface(IBaseInterface)
['{6CF5DA70-2EE9-48B1-9461-8A52CD29A626}']
procedure Save(const aFilename: WideString);
procedure Load(aArchive: IArchive; const aFilename: WideString);
procedure CopyFrom(aPolygon: IPolygon);
procedure AddLocalPoint(aX: Single; aY: Single; aVisible: Boolean);
function Transform(aX: Single; aY: Single; aScale: Single; aAngle: Single; aOrigin: PVector; aHFlip: Boolean; aVFlip: Boolean): Boolean;
procedure Render(aX: Single; aY: Single; aScale: Single; aAngle: Single; aThickness: Integer; aColor: TColor; aOrigin: PVector; aHFlip: Boolean; aVFlip: Boolean);
procedure SetSegmentVisible(aIndex: Integer; aVisible: Boolean);
function GetSegmentVisible(aIndex: Integer): Boolean;
function GetPointCount: Integer;
function GetWorldPoint(aIndex: Integer): PVector;
function GetLocalPoint(aIndex: Integer): PVector;
end;
{ --- SPRITE ---------------------------------------------------------------- }
type
{ ISprite }
ISprite = interface(IBaseInterface)
['{0D12F0DF-0BD4-42B3-98D9-35E3CC2644E2}']
procedure Clear;
function LoadPage(aArchive: IArchive; const aFilename: WideString; aColorKey: PColor): Integer;
function AddGroup: Integer;
function GetGroupCount: Integer;
function AddImageFromRect(aPage: Integer; aGroup: Integer; aRect: TRectangle): Integer;
function AddImageFromGrid(aPage: Integer; aGroup: Integer; aGridX: Integer; aGridY: Integer; aGridWidth: Integer; aGridHeight: Integer): Integer;
function GetImageCount(aGroup: Integer): Integer;
function GetImageWidth(aNum: Integer; aGroup: Integer): Single;
function GetImageHeight(aNum: Integer; aGroup: Integer): Single;
function GetImageTexture(aNum: Integer; aGroup: Integer): IBitmap;
function GetImageRect(aNum: Integer; aGroup: Integer): TRectangle;
procedure DrawImage(aNum: Integer; aGroup: Integer; aX: Single; aY: Single; aOrigin: PVector; aScale: PVector; aAngle: Single; aColor: TColor; aHFlip: Boolean; aVFlip: Boolean; aDrawPolyPoint: Boolean);
function GroupPolyPoint(aGroup: Integer): Pointer;
procedure GroupPolyPointTrace(aGroup: Integer; aMju: Single=6; aMaxStepBack: Integer=12; aAlphaThreshold: Integer=70; aOrigin: PVector=nil);
function GroupPolyPointCollide(aNum1: Integer; aGroup1: Integer;
aX1: Single; aY1: Single; aScale1: Single; aAngle1: Single;
aOrigin1: PVector; aHFlip1: Boolean; aVFlip1: Boolean; aSprite2: ISprite;
aNum2: Integer; aGroup2: Integer; aX2: Single; aY2: Single;
aScale2: Single; aAngle2: Single; aOrigin2: PVector; aHFlip2: Boolean;
aVFlip2: Boolean; aShrinkFactor: Single; var aHitPos: TVector): Boolean;
function GroupPolyPointCollidePoint(aNum: Integer; aGroup: Integer;
aX: Single; aY: Single; aScale: Single; aAngle: Single; aOrigin: PVector;
aHFlip: Boolean; aVFlip: Boolean; aShrinkFactor: Single;
var aPoint: TVector): Boolean;
end;
{ --- ENTITY ---------------------------------------------------------------- }
type
{ IEntity }
IEntity = interface(IBaseInterface)
['{FF9F89EB-65E8-48B3-8939-0BB7BFA8E890}']
procedure Init(aSprite: ISprite; aGroup: Integer);
procedure SetFrameRange(aFirst: Integer; aLast: Integer);
function NextFrame: Boolean;
function PrevFrame: Boolean;
function GetFrame: Integer;
procedure SetFrame(aFrame: Integer);
function GetFrameFPS: Single;
procedure SetFrameFPS(aFrameFPS: Single);
function GetFirstFrame: Integer;
function GetLastFrame: Integer;
procedure SetPosAbs(aX: Single; aY: Single);
procedure SetPosRel(aX: Single; aY: Single);
function GetPos: TVector;
function GetDir: TVector;
procedure SetScaleAbs(aScale: Single);
procedure SetScaleRel(aScale: Single);
function GetAngle: Single;
function GetAngleOffset: Single;
procedure SetAngleOffset(aAngle: Single);
procedure RotateAbs(aAngle: Single);
procedure RotateRel(aAngle: Single);
function RotateToAngle(aAngle: Single; aSpeed: Single): Boolean;
function RotateToPos(aX: Single; aY: Single; aSpeed: Single): Boolean;
function RotateToPosAt(aSrcX: Single; aSrcY: Single; aDestX: Single; aDestY: Single; aSpeed: Single): Boolean;
procedure Thrust(aSpeed: Single);
procedure ThrustAngle(aAngle: Single; aSpeed: Single);
function ThrustToPos(aThrustSpeed: Single; aRotSpeed: Single; aDestX: Single; aDestY: Single; aSlowdownDist: Single; aStopDist: Single; aStopSpeed: Single; aStopSpeedEpsilon: Single; aDeltaTime: Single): Boolean;
function IsVisible(aVirtualX: Single; aVirtualY: Single): Boolean;
function IsFullyVisible(aVirtualX: Single; aVirtualY: Single): Boolean;
function Overlap(aX: Single; aY: Single; aRadius: Single; aShrinkFactor: Single): Boolean; overload;
function Overlap(aEntity: IEntity): Boolean; overload;
procedure Render(aVirtualX: Single; aVirtualY: Single);
procedure RenderAt(aX: Single; aY: Single);
function GetSprite: ISprite;
function GetGroup: Integer;
function GetScale: Single;
function GetColor: TColor;
procedure SetColor(aColor: TColor);
procedure GetFlipMode(aHFlip: PBoolean; aVFlip: PBoolean);
procedure SetFlipMode(aHFlip: PBoolean; aVFlip: PBoolean);
function GetLoopFrame: Boolean;
procedure SetLoopFrame(aLoop: Boolean);
function GetWidth: Single;
function GetHeight: Single;
function GetRadius: Single;
function GetShrinkFactor: Single;
procedure SetShrinkFactor(aShrinkFactor: Single);
procedure SetRenderPolyPoint(aRenderPolyPoint: Boolean);
function GetRenderPolyPoint: Boolean;
procedure TracePolyPoint(aMju: Single=6; aMaxStepBack: Integer=12; aAlphaThreshold: Integer=70; aOrigin: PVector=nil);
function CollidePolyPoint(aEntity: IEntity; var aHitPos: TVector): Boolean;
function CollidePolyPointPoint(var aPoint: TVector): Boolean;
end;
{ --- STARTUPDIALOG --------------------------------------------------------- }
type
{ TStartupDialogState }
TStartupDialogState = (sdsMore = 0, sdsRun = 1, sdsQuit = 2);
{ IStartupDialog }
IStartupDialog = interface(IBaseInterface)
['{68BCF3B9-A190-4A46-94C6-5FF6D389A198}']
procedure SetCaption(const aCaption: WideString);
procedure SetIcon(aArchive: IArchive; const aFilename: WideString);
procedure SetLogo(aArchive: IArchive; const aFilename: WideString);
procedure SetLogoClickUrl(const aURL: WideString);
procedure SetReadme(aArchive: IArchive; const aFilename: WideString);
procedure SetReadmeText(const aText: WideString);
procedure SetLicense(aArchive: IArchive; const aFilename: WideString);
procedure SetLicenseText(const aText: WideString);
procedure SetReleaseInfo(const aReleaseInfo: WideString);
procedure SetWordWrap(aWrap: Boolean);
function Show: TStartupDialogState;
procedure Hide;
end;
{ --- TREEMENU -------------------------------------------------------------- }
const
{ TreeMenu }
TREEMENU_NONE = -1;
TREEMENU_QUIT = -2;
type
{ ITreeMenu }
ITreeMenu = interface(IBaseInterface)
['{6FB28C3F-3848-43AF-9FC8-C6EE49B41D4C}']
procedure SetTitle(const aTitle: WideString);
procedure SetStatus(const aTitle: WideString);
procedure Clear;
function First(aParent: Integer): Integer;
function AddItem(aParent: Integer; const aName: WideString; aId: Integer; aEnabled: Boolean): Integer;
function InsertItem(aSibling: Integer; const aName: WideString; aId: Integer; aEnabled: Boolean): Integer;
procedure Sort(aParent: Integer);
procedure SelItem(aId: Integer);
procedure BoldItemId(aId: Integer; aValue: Boolean);
procedure BoldItem(const aItem: WideString; aValue: Boolean);
function Show(aId: Integer): Integer;
function GetCount: Integer;
function GetLastSelectedId: Integer;
function GetSelectableCount: Integer;
end;
{ --- DIALOG ---------------------------------------------------------------- }
type
{ TShowMessage }
TShowMessage = (smDefault = $00000000, smError = $00000010,
smWarning = $00000030, smInformation = $00000040);
{ TConfirmDialogResult }
TConfirmDialogResult = (cdYes, cdNo, cdCancel);
{ IDialog }
IDialog = interface(IBaseInterface)
['{A28162B8-8EAB-4C71-9DC5-7241DD8D82B7}']
function DirectoryOpen(const aTitle: WideString; const aInitialDir: WideString; var aDirName: WideString): Boolean;
function FileOpen(const aTitle: WideString; const aFilter: WideString; aFilterIndex: Integer; const aDefaultExt: WideString; const aInitialDir: WideString; var aFilename: WideString): Boolean;
function FileSave(const aTitle: WideString; const aFilter: WideString; aFilterIndex: Integer; const aDefaultExt: WideString; var aFilename: WideString): Boolean;
function Confirm(const aMsg: WideString; const aArgs: array of const): TConfirmDialogResult;
procedure ContactUs(const aServer: WideString; aPort: Integer; const aUsername: WideString; const aPassword: WideString; const aEmail: WideString);
procedure Feedback(const aServer: WideString; aPort: Integer; const aUsername: WideString; const aPassword: WideString; const aEmail: WideString; const aSubject: WideString);
procedure ShowMessage(const aTitle: WideString; const aMsg: WideString; aType: TShowMessage);
end;
{ --- GAME ------------------------------------------------------------------ }
type
{ TGameEvent }
PGameEvent = ^TGameEvent;
TGameEvent = record
Sender: Pointer;
OnLoadConfig: procedure(aSender: Pointer);
OnSaveConfig: procedure(aSender: Pointer);
OnStartup: procedure(aSender: Pointer);
OnShutdown: procedure(aSender: Pointer);
OnUpdateFrame: procedure(aSender: Pointer; aDeltaTime: Double);
OnClearFrame: procedure(aSender: Pointer);
OnShowFrame: procedure(aSender: Pointer);
OnRenderFrame: procedure(aSender: Pointer);
OnVideoFinished: procedure(aSender: Pointer; const aFilename: WideString);
OnVideoLoad: procedure(aSender: Pointer; const aFilename: WideString);
OnVideoUnload: procedure(aSender: Pointer; const aFilename: WideString);
OnRenderHUD: procedure(aSender: Pointer);
OnSpeechWord: procedure(aSender: Pointer; const aWord: WideString; const aText: WideString);
end;
{ TBaseGame }
TBaseGame = class(TBaseObject)
protected
FGameEvent: TGameEvent;
public
constructor Create; override;
destructor Destroy; override;
procedure OnLoadConfig; virtual;
procedure OnSaveConfig; virtual;
procedure OnStartup; virtual;
procedure OnShutdown; virtual;
procedure OnUpdateFrame(aDeltaTime: Double); virtual;
procedure OnClearFrame; virtual;
procedure OnShowFrame; virtual;
procedure OnRenderFrame; virtual;
procedure OnVideoFinished(const aFilename: WideString); virtual;
procedure OnVideoLoad(const aFilename: WideString); virtual;
procedure OnVideoUnload(const aFilename: WideString); virtual;
procedure OnRenderHUD; virtual;
procedure OnSpeechWord(const aWord: WideString; const aText: WideString); virtual;
end;
{ TBaseGameClass }
TBaseGameClass = class of TBaseGame;
{ --- PIRO ------------------------------------------------------------------ }
type
{ IPiro }
IPiro = interface(IBaseInterface)
['{1FBB4A40-FC96-42F3-8698-6687923B781C}']
function Get(const aGUID: TGUID; const [ref] aInterface: IBaseInterface): Boolean;
function Release(const [ref] aInterface: IBaseInterface): Boolean;
function GetTerminated: Boolean;
procedure SetTerminated(aTerminate: Boolean);
function GetTime: Double;
procedure ResetTiming;
procedure SetUpdateSpeed(aSpeed: Single);
function GetUpdateSpeed: Single;
function GetDeltaTime: Double;
function GetFrameRate: Cardinal;
function FrameSpeed(var aTimer: Single; aSpeed: Single): Boolean;
function FrameElapsed(var aTimer: Single; aFrames: Single): Boolean;
function CmdLine: ICmdLine;
function Audio: IAudio;
function Color: IColor;
function Display: IDisplay;
function Input: IInput;
function Math: IMath;
function Video: IVideo;
function Screenshake: IScreenshake;
function Screenshot: IScreenshot;
function Collision: ICollision;
function Async: IAsync;
function Speech: ISpeech;
function Ease: IEase;
function Dialog: IDialog;
procedure RunGame(aGameEvent: PGameEvent);
function GetVersion: WideString;
procedure Log(const aMsg: WideString; const aArgs: array of const; aWriteToConsole: Boolean=False); overload;
procedure Log(aCondition: Boolean; const aTrueMsg: WideString; const aFalseMsg: WideString; const aArgs: array of const; aWriteToConsole: Boolean=False); overload;
procedure DeferTask(aProc: TProc);
end;
{$IFNDEF PGT_DLL}
var
Piro: IPiro = nil;
procedure PiroRunGame(aGame: TBaseGameClass);
procedure PiroLoad;
procedure PiroUnload;
{$ENDIF}
implementation
{$IFDEF PGT_DLL}
uses
uEngine;
{$ENDIF}
{ --- BASE ------------------------------------------------------------------ }
{ TBaseObject }
constructor TBaseObject.Create;
begin
inherited;
end;
destructor TBaseObject.Destroy;
begin
inherited;
end;
{ TBaseInterface }
constructor TBaseInterface.Create;
begin
inherited;
end;
destructor TBaseInterface.Destroy;
begin
inherited;
end;
{ --- MATH ------------------------------------------------------------------ }
{ TVector }
constructor TVector.Create(aX: Single; aY: Single);
begin
Assign(aX, aY);
Z := 0;
end;
procedure TVector.Assign(aX: Single; aY: Single);
begin
X := aX;
Y := aY;
end;
procedure TVector.Assign(aX: Single; aY: Single; aZ: Single);
begin
X := aX;
Y := aY;
Z := aZ;
end;
procedure TVector.Clear;
begin
X := 0;
Y := 0;
Z := 0;
end;
procedure TVector.Assign(aVector: TVector);
begin
X := aVector.X;
Y := aVector.Y;
end;
procedure TVector.Add(aVector: TVector);
begin
X := X + aVector.X;
Y := Y + aVector.Y;
end;
procedure TVector.Subtract(aVector: TVector);
begin
X := X - aVector.X;
Y := Y - aVector.Y;
end;
procedure TVector.Multiply(aVector: TVector);
begin
X := X * aVector.X;
Y := Y * aVector.Y;
end;
procedure TVector.Divide(aVector: TVector);
begin
X := X / aVector.X;
Y := Y / aVector.Y;
end;
function TVector.Magnitude: Single;
begin
Result := Sqrt((X * X) + (Y * Y));
end;
function TVector.MagnitudeTruncate(aMaxMagitude: Single): TVector;
var
LMaxMagSqrd: Single;
LVecMagSqrd: Single;
LTruc: Single;
begin
Result.Assign(X, Y);
LMaxMagSqrd := aMaxMagitude * aMaxMagitude;
LVecMagSqrd := Result.Magnitude;
if LVecMagSqrd > LMaxMagSqrd then
begin
LTruc := (aMaxMagitude / Sqrt(LVecMagSqrd));
Result.X := Result.X * LTruc;
Result.Y := Result.Y * LTruc;
end;
end;
function TVector.Distance(aVector: TVector): Single;
var
LDirVec: TVector;
begin
LDirVec.X := X - aVector.X;
LDirVec.Y := Y - aVector.Y;
Result := LDirVec.Magnitude;
end;
procedure TVector.Normalize;
var
LLen, LOOL: Single;
begin
LLen := self.Magnitude;
if LLen <> 0 then
begin
LOOL := 1.0 / LLen;
X := X * LOOL;
Y := Y * LOOL;
end;
end;
function TVector.Angle(aVector: TVector): Single;
var
LXOY: Single;
LR: TVector;
begin
LR.Assign(self);
LR.Subtract(aVector);
LR.Normalize;
if LR.Y = 0 then
begin
LR.Y := 0.001;
end;
LXOY := LR.X / LR.Y;
Result := ArcTan(LXOY) * RAD2DEG;
if LR.Y < 0 then
Result := Result + 180.0;
end;
procedure TVector.Thrust(aAngle: Single; aSpeed: Single);
var
LA: Single;
begin
LA := aAngle + 90.0;
Piro.Math.ClipValue(LA, 0, 360, True);
X := X + Piro.Math.AngleCos(Round(LA)) * -(aSpeed);
Y := Y + Piro.Math.AngleSin(Round(LA)) * -(aSpeed);
end;
function TVector.MagnitudeSquared: Single;
begin
Result := (X * X) + (Y * Y);
end;
function TVector.DotProduct(aVector: TVector): Single;
begin
Result := (X * aVector.X) + (Y * aVector.Y);
end;
procedure TVector.Scale(aValue: Single);
begin
X := X * aValue;
Y := Y * aValue;
end;
procedure TVector.DivideBy(aValue: Single);
begin
X := X / aValue;
Y := Y / aValue;
end;
function TVector.Project(aVector: TVector): TVector;
var
LDP: Single;
begin
LDP := self.DotProduct(aVector);
Result.X := (LDP / (aVector.X * aVector.X + aVector.Y * aVector.Y)) * aVector.X;
Result.Y := (LDP / (aVector.X * aVector.X + aVector.Y * aVector.Y)) * aVector.Y;
end;
procedure TVector.Negate;
begin
X := -X;
Y := -Y;
end;
{ TRectangle }
constructor TRectangle.Create(aX: Single; aY: Single; aWidth: Single; aHeight: Single);
begin
Assign(aX, aY, aWidth, aHeight);
end;
procedure TRectangle.Assign(aX: Single; aY: Single; aWidth: Single; aHeight: Single);
begin
X := aX;
Y := aY;
Width := aWidth;
Height := aHeight;
end;
function TRectangle.Intersect(aRect: TRectangle): Boolean;
var
LR1R, LR1B: Single;
LR2R, LR2B: Single;
begin
LR1R := X - (Width - 1);
LR1B := Y - (Height - 1);
LR2R := aRect.X - (aRect.Width - 1);
LR2B := aRect.Y - (aRect.Height - 1);
Result := (X < LR2R) and (LR1R > aRect.X) and (Y < LR2B) and (LR1B > aRect.Y);
end;
{ --- GAME ------------------------------------------------------------------ }
procedure TBaseGame_OnLoadConfig(aSender: Pointer);
begin
TBaseGame(aSender).OnLoadConfig;
end;
procedure TBaseGame_OnSaveConfig(aSender: Pointer);
begin
TBaseGame(aSender).OnSaveConfig;
end;
procedure TBaseGame_OnStartup(aSender: Pointer);
begin
TBaseGame(aSender).OnStartup;
end;
procedure TBaseGame_OnShutdown(aSender: Pointer);
begin
TBaseGame(aSender).OnShutdown;
end;
procedure TBaseGame_OnUpdateFrame(aSender: Pointer; aDeltaTime: Double);
begin
TBaseGame(aSender).OnUpdateFrame(aDeltaTime);
end;
procedure TBaseGame_OnClearFrame(aSender: Pointer);
begin
TBaseGame(aSender).OnClearFrame;
end;
procedure TBaseGame_OnRenderFrame(aSender: Pointer);
begin
TBaseGame(aSender).OnRenderFrame;
end;
procedure TBaseGame_OnShowFrame(aSender: Pointer);
begin
TBaseGame(aSender).OnShowFrame;
end;
procedure TBaseGame_OnVideoFinished(aSender: Pointer; const aFilename: WideString);
begin
TBaseGame(aSender).OnVideoFinished(aFilename);
end;
procedure TBaseGame_OnVideoLoad(aSender: Pointer; const aFilename: WideString);
begin
TBaseGame(aSender).OnVideoLoad(aFilename);
end;
procedure TBaseGame_OnVideoUnload(aSender: Pointer; const aFilename: WideString);
begin
TBaseGame(aSender).OnVideoUnload(aFilename);
end;
procedure TBaseGame_OnRenderHUD(aSender: Pointer);
begin
TBaseGame(aSender).OnRenderHUD;
end;
procedure TBaseGame_OnSpeechWord(aSender: Pointer; const aWord: WideString; const aText: WideString);
begin
TBaseGame(aSender).OnSpeechWord(aWord, aText);
end;
{ TBaseGame }
constructor TBaseGame.Create;
begin
inherited;
FGameEvent.Sender := Self;
FGameEvent.OnLoadConfig := TBaseGame_OnLoadConfig;
FGameEvent.OnSaveConfig := TBaseGame_OnSaveConfig;
FGameEvent.OnStartup := TBaseGame_OnStartup;
FGameEvent.OnShutdown := TBaseGame_OnShutdown;
FGameEvent.OnUpdateFrame := TBaseGame_OnUpdateFrame;
FGameEvent.OnClearFrame := TBaseGame_OnClearFrame;
FGameEvent.OnRenderFrame := TBaseGame_OnRenderFrame;
FGameEvent.OnShowFrame := TBaseGame_OnShowFrame;
FGameEvent.OnVideoFinished := TBaseGame_OnVideoFinished;
FGameEvent.OnVideoLoad := TBaseGame_OnVideoLoad;
FGameEvent.OnVideoUnload := TBaseGame_OnVideoUnload;
FGameEvent.OnRenderHUD := TBaseGame_OnRenderHUD;
FGameEvent.OnSpeechWord := TBaseGame_OnSpeechWord;
end;
destructor TBaseGame.Destroy;
begin
inherited;
end;
procedure TBaseGame.OnLoadConfig;
begin
end;
procedure TBaseGame.OnSaveConfig;
begin
end;
procedure TBaseGame.OnStartup;
begin
end;
procedure TBaseGame.OnShutdown;
begin
end;
procedure TBaseGame.OnUpdateFrame(aDeltaTime: Double);
begin
end;
procedure TBaseGame.OnClearFrame;
begin
end;
procedure TBaseGame.OnShowFrame;
begin
end;
procedure TBaseGame.OnRenderFrame;
begin
end;
procedure TBaseGame.OnVideoFinished(const aFilename: WideString);
begin
end;
procedure TBaseGame.OnVideoLoad(const aFilename: WideString);
begin
end;
procedure TBaseGame.OnVideoUnload(const aFilename: WideString);
begin
end;
procedure TBaseGame.OnRenderHUD;
begin
end;
procedure TBaseGame.OnSpeechWord(const aWord: WideString; const aText: WideString);
begin
end;
{ --- PIRO ------------------------------------------------------------------ }
{$IFNDEF PGT_DLL}
function PiroSingleInstance(const aTrueMsg: WideString; const aFalseMsg: WideString): Boolean; external PGT_DLL_NAME;
procedure PiroProcess(const [ref] aPiro: IPiro); external PGT_DLL_NAME;
procedure PiroRunGame(aGame: TBaseGameClass);
var
LGame: TBaseGame;
begin
if not PiroSingleInstance('','An instance of this application is already running, terminating!') then
Exit;
try
PiroProcess(Piro);
try
LGame := aGame.Create;
try
Piro.RunGame(@LGame.FGameEvent);
finally
FreeAndNil(LGame);
end;
finally
PiroProcess(Piro);
end;
except
on E: Exception do
Piro.Log('%s: %s', [E.ClassName, E.Message]);
end;
end;
procedure PiroLoad;
begin
if Piro = nil then
begin
PiroProcess(Piro);
end;
end;
procedure PiroUnload;
begin
if Piro <> nil then
begin
PiroProcess(Piro);
end;
end;
{$ENDIF}
{ --------------------------------------------------------------------------- }
initialization
ReportMemoryLeaksOnShutdown := True;
end.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment