Написание игрового движка на PascalABC.Net
Как заставить работать игровой движок
[править]Скопируйте код всех модулей и разместите их всех в одной папке, туда же положите примеры работы с движком.
События
[править]Предоставляет данные событий для пользователя.
/// Предоставляет классы аргументов событий.
unit EventArgsTypes;
uses System;
type
[SerializableAttribute]
/// Главный класс аргументов события.
TEventArgs = class
private
_Time: DateTime;
_IsUp: boolean;
public
/// Время происхождения события
property Time: DateTime read _Time;
/// Относится к классам потомкам
property IsUp: boolean read _IsUp;
constructor(whenUp: boolean := false);
begin
_Time := DateTime.Now;
_IsUp := whenUp;
end;
/// Возвращает строковое представление объекта.
function ToString() := Format('Time: {0}, IsUp: {1}', _Time, _IsUp);
/// Выводит строковое представление объекта.
procedure Print() := Write(ToString());
/// Выводит строковое представление объекта и переходит на новую строку.
procedure Println() := Writeln(ToString());
end;
/// Кнопки мыши
MouseButtonEnum = (None, Left, Right);
[SerializableAttribute]
/// Представляет аргументы событий OnMouseDownAction, OnMouseUpAction, OnMouseMoveAction и OnMouseOver.
TMouseEventArgs = sealed class(TEventArgs)
private
_X, _Y: integer;
_MouseButton: MouseButtonEnum;
public
/// X координата курсора на момент наступления события
property X: integer read _X;
/// Y координата курсора на момент наступления события
property Y: integer read _Y;
/// Нажатая кнопка мыши на момент наступления события
property MouseButton: MouseButtonEnum read _MouseButton;
constructor(cx, cy: integer; btn: MouseButtonEnum := MouseButtonEnum.None; whenUp: boolean := false);
begin
inherited Create(whenUp);
_X := cx;_Y := cy;
_MouseButton := btn;
end;
/// Возвращает строковое представление объекта.
function ToString() := Format('X: {0}, Y: {1}, MouseButton: {2}', _X, _Y, _MouseButton);
/// Выводит строковое представление объекта.
procedure Print() := Write(ToString());
/// Выводит строковое представление объекта и переходит на новую строку.
procedure Println() := Writeln(ToString());
end;
[SerializableAttribute]
/// Представляет аргументы событий OnKeyDownAction, OnKeyUpAction.
TKeyboardEventArgs = sealed class(TEventArgs)
private
_Code: integer;
public
/// Код нажатой клавиши на момент наступления события
property Code: integer read _Code;
constructor(c: integer; whenUp: boolean := false);
begin
inherited Create(whenUp);
_Code := c;
end;
/// Возвращает строковое представление объекта.
function ToString() := Format('Code: {0}', _Code);
/// Выводит строковое представление объекта.
procedure Print() := Write(ToString());
/// Выводит строковое представление объекта и переходит на новую строку.
procedure Println() := Writeln(ToString());
end;
///Класс, предоставляющий данные событий изменения свойств объектов.
[SerializableAttribute]
TPropertyChangedEventArgs = sealed class(TEventArgs)
private
_Name: string;
_PropDescription: string;
public
/// Имя измененного свойства
property Name: string read _Name;
/// Описание измененного свойства
property PropDescription: string read _PropDescription;
constructor(n, descr: string); // whenUp не играет никакой роли в данном случае.
begin
inherited Create();
_Name := n;
_PropDescription := descr;
end;
/// Возвращает строковое представление объекта.
function ToString() := Format('Name: {0}, PropDescription: {1}', _Name, _PropDescription);
/// Выводит строковое представление объекта.
procedure Print() := Write(ToString());
/// Выводит строковое представление объекта и переходит на новую строку.
procedure Println() := Writeln(ToString());
end;
type
///Обработчик событий OnMouseDownAction, OnMouseUpAction, OnMouseMoveAction и OnMouseOver.
TMouseEventHandler = procedure(sender: object; e: TMouseEventArgs);
///Обработчик событий OnKeyDownAction, OnKeyUpAction.
TKeyboardEventHandler = procedure(sender: object; e: TKeyboardEventArgs);
///Обработчик события TPropertyChangedEventArgs.
TPropertyChangedEventHandler = procedure(sender: object; e: TPropertyChangedEventArgs);
end.
Стили объектов
[править]Предоставляет классы стилей объектов.
/// Предоставляет стили оформления объектов.
unit Styles;
uses GraphABC, BaseGraphSystem;
type
///Стиль оформления объекта.
TStyle = class
private
_BorderColor, _FillColor: TColor;
_BorderWidth: integer;
public
/// Цвет границы объекта
property BorderColor: TColor read _BorderColor write _BorderColor;
/// Цвет заливки объекта
property FillColor: TColor read _FillColor write _FillColor;
/// Толщина границы объекта
property BorderWidth: integer read _BorderWidth write _BorderWidth;
constructor(borderCol: TColor := clBlack; fillCol: TColor := clWhite; borderW: integer := 1);
begin
BorderColor := borderCol;
FillColor := fillCol;
BorderWidth := borderW;
end;
procedure SetDrawSettingsBySelf();
begin
SetPenColor(_BorderColor);
SetBrushColor(_FillColor);
SetPenWidth(_BorderWidth);
end;
/// Возвращает строковое представление объекта.
function ToString() := Format('BorderColor: {0}, FillColor: {1}, BorderWidth: {2}', _BorderColor, _FillColor, _BorderWidth);
/// Выводит строковое представление объекта.
procedure Print() := Write(ToString());
/// Выводит строковое представление объекта и переходит на новую строку.
procedure Println() := Writeln(ToString());
end;
///Стиль оформления шрифта.
TFontStyle = class
private
_FontColor: TColor;
_FontName: string;
_FontSize: integer;
public
/// Цвет шрифта
property FontColor: TColor read _FontColor write _FontColor;
/// Имя шрифта
property FontName: string read _FontName write _FontName;
/// Размер шрифта
property FontSize: integer read _FontSize write _FontSize;
constructor(fontCol: TColor := clBlack; fontN: string := 'Arial'; fontS: integer := 14);
begin
FontColor := fontCol;
FontName := fontN;
FontSize := fontS;
end;
procedure SetFontSettingsBySelf();
begin
SetFontColor(_FontColor);
SetFontName(_FontName);
SetFontSize(_FontSize);
end;
/// Возвращает строковое представление объекта.
function ToString() := Format('FontColor: {0}, FontName: {1}, FontSize: {2}', _FontColor, _FontName, _FontSize);
/// Выводит строковое представление объекта.
procedure Print() := Write(ToString());
/// Выводит строковое представление объекта и переходит на новую строку.
procedure Println() := Writeln(ToString());
end;
var
DefaultObjectStyle: TStyle := new TStyle();
RedObjectStyle: TStyle := new TStyle(clPink, clRed);
OrangeObjectStyle: TStyle := new TStyle(clRed, clOrange);
YellowObjectStyle: TStyle := new TStyle(clOrange, clYellow);
GreenObjectStyle: TStyle := new TStyle(clDarkGreen, clGreen);
BlueObjectStyle: TStyle := new TStyle(clBlue, clLightBlue);
DefaultFontStyle: TFontStyle := new TFontStyle();
RedFontStyle: TFontStyle := new TFontStyle(clRed);
OrangeFontStyle: TFontStyle := new TFontStyle(clOrange);
YellowFontStyle: TFontStyle := new TFontStyle(clYellow);
GreenFontStyle: TFontStyle := new TFontStyle(clDarkGreen);
BlueFontStyle: TFontStyle := new TFontStyle(clBlue);
end.
Графический компонент
[править]Предоставляет минимум графических процедур и функций движка для графики (часть из них переопределяет стандартные для сохранения стиля кода движка).
/// Предоставляет базовые процедуры и функции для работы с графикой в игровом движке.
unit BaseGraphSystem;
uses GraphABC;
const
// Color constants
clAquamarine = Color.Aquamarine; clAzure = Color.Azure;
clBeige = Color.Beige; clBisque = Color.Bisque;
clBlack = Color.Black; clBlanchedAlmond = Color.BlanchedAlmond;
clBlue = Color.Blue; clBlueViolet = Color.BlueViolet;
clBrown = Color.Brown; clBurlyWood = Color.BurlyWood;
clCadetBlue = Color.CadetBlue; clChartreuse = Color.Chartreuse;
clChocolate = Color.Chocolate; clCoral = Color.Coral;
clCornflowerBlue = Color.CornflowerBlue; clCornsilk = Color.Cornsilk;
clCrimson = Color.Crimson; clCyan = Color.Cyan;
clDarkBlue = Color.DarkBlue; clDarkCyan = Color.DarkCyan;
clDarkGoldenrod = Color.DarkGoldenrod; clDarkGray = Color.DarkGray;
clDarkGreen = Color.DarkGreen; clDarkKhaki = Color.DarkKhaki;
clDarkMagenta = Color.DarkMagenta; clDarkOliveGreen = Color.DarkOliveGreen;
clDarkOrange = Color.DarkOrange; clDarkOrchid = Color.DarkOrchid;
clDarkRed = Color.DarkRed; clDarkTurquoise = Color.DarkTurquoise;
clDarkSeaGreen = Color.DarkSeaGreen; clDarkSlateBlue = Color.DarkSlateBlue;
clDarkSlateGray = Color.DarkSlateGray; clDarkViolet = Color.DarkViolet;
clDeepPink = Color.DeepPink; clDarkSalmon = Color.DarkSalmon;
clDeepSkyBlue = Color.DeepSkyBlue; clDimGray = Color.DimGray;
clDodgerBlue = Color.DodgerBlue; clFirebrick = Color.Firebrick;
clFloralWhite = Color.FloralWhite; clForestGreen = Color.ForestGreen;
clFuchsia = Color.Fuchsia; clGainsboro = Color.Gainsboro;
clGhostWhite = Color.GhostWhite; clGold = Color.Gold;
clGoldenrod = Color.Goldenrod; clGray = Color.Gray;
clGreen = Color.Green; clGreenYellow = Color.GreenYellow;
clHoneydew = Color.Honeydew; clHotPink = Color.HotPink;
clIndianRed = Color.IndianRed; clIndigo = Color.Indigo;
clIvory = Color.Ivory; clKhaki = Color.Khaki;
clLavender = Color.Lavender; clLavenderBlush = Color.LavenderBlush;
clLawnGreen = Color.LawnGreen; clLemonChiffon = Color.LemonChiffon;
clLightBlue = Color.LightBlue; clLightCoral = Color.LightCoral;
clLightCyan = Color.LightCyan; clLightGray = Color.LightGray;
clLightGreen = Color.LightGreen; clLightGoldenrodYellow = Color.LightGoldenrodYellow;
clLightPink = Color.LightPink; clLightSalmon = Color.LightSalmon;
clLightSeaGreen = Color.LightSeaGreen; clLightSkyBlue = Color.LightSkyBlue;
clLightSlateGray = Color.LightSlateGray; clLightSteelBlue = Color.LightSteelBlue;
clLightYellow = Color.LightYellow; clLime = Color.Lime;
clLimeGreen = Color.LimeGreen; clLinen = Color.Linen;
clMagenta = Color.Magenta; clMaroon = Color.Maroon;
clMediumBlue = Color.MediumBlue; clMediumOrchid = Color.MediumOrchid;
clMediumAquamarine = Color.MediumAquamarine; clMediumPurple = Color.MediumPurple;
clMediumSeaGreen = Color.MediumSeaGreen; clMediumSlateBlue = Color.MediumSlateBlue;
clPlum = Color.Plum; clMistyRose = Color.MistyRose;
clNavy = Color.Navy; clMidnightBlue = Color.MidnightBlue;
clMintCream = Color.MintCream; clMediumSpringGreen = Color.MediumSpringGreen;
clMoccasin = Color.Moccasin; clNavajoWhite = Color.NavajoWhite;
clMediumTurquoise = Color.MediumTurquoise; clOldLace = Color.OldLace;
clOlive = Color.Olive; clOliveDrab = Color.OliveDrab;
clOrange = Color.Orange; clOrangeRed = Color.OrangeRed;
clOrchid = Color.Orchid; clPaleGoldenrod = Color.PaleGoldenrod;
clPaleGreen = Color.PaleGreen; clPaleTurquoise = Color.PaleTurquoise;
clPaleVioletRed = Color.PaleVioletRed; clPapayaWhip = Color.PapayaWhip;
clPeachPuff = Color.PeachPuff; clPeru = Color.Peru;
clPink = Color.Pink; clMediumVioletRed = Color.MediumVioletRed;
clPowderBlue = Color.PowderBlue; clPurple = Color.Purple;
clRed = Color.Red; clRosyBrown = Color.RosyBrown;
clRoyalBlue = Color.RoyalBlue; clSaddleBrown = Color.SaddleBrown;
clSalmon = Color.Salmon; clSandyBrown = Color.SandyBrown;
clSeaGreen = Color.SeaGreen; clSeaShell = Color.SeaShell;
clSienna = Color.Sienna; clSilver = Color.Silver;
clSkyBlue = Color.SkyBlue; clSlateBlue = Color.SlateBlue;
clSlateGray = Color.SlateGray; clSnow = Color.Snow;
clSpringGreen = Color.SpringGreen; clSteelBlue = Color.SteelBlue;
clTan = Color.Tan; clTeal = Color.Teal;
clThistle = Color.Thistle; clTomato = Color.Tomato;
clTransparent = Color.Transparent; clTurquoise = Color.Turquoise;
clViolet = Color.Violet; clWheat = Color.Wheat;
clWhite = Color.White; clWhiteSmoke = Color.WhiteSmoke;
clYellow = Color.Yellow; clYellowGreen = Color.YellowGreen;
// Virtual Key Codes
VK_Back = 8; VK_Tab = 9;
VK_LineFeed = 10; VK_Enter = 13;
VK_Return = 13; VK_ShiftKey = 16; VK_ControlKey = 17;
VK_Menu = 18; VK_Pause = 19; VK_CapsLock = 20;
VK_Capital = 20;
VK_Escape = 27;
VK_Space = 32;
VK_Prior = 33; VK_PageUp = 33; VK_PageDown = 34;
VK_Next = 34; VK_End = 35; VK_Home = 36;
VK_Left = 37; VK_Up = 38; VK_Right = 39;
VK_Down = 40; VK_Select = 41; VK_Print = 42;
VK_Snapshot = 44; VK_PrintScreen = 44;
VK_Insert = 45; VK_Delete = 46; VK_Help = 47;
VK_A = 65; VK_B = 66;
VK_C = 67; VK_D = 68; VK_E = 69;
VK_F = 70; VK_G = 71; VK_H = 72;
VK_I = 73; VK_J = 74; VK_K = 75;
VK_L = 76; VK_M = 77; VK_N = 78;
VK_O = 79; VK_P = 80; VK_Q = 81;
VK_R = 82; VK_S = 83; VK_T = 84;
VK_U = 85; VK_V = 86; VK_W = 87;
VK_X = 88; VK_Y = 89; VK_Z = 90;
VK_LWin = 91; VK_RWin = 92; VK_Apps = 93;
VK_Sleep = 95; VK_NumPad0 = 96; VK_NumPad1 = 97;
VK_NumPad2 = 98; VK_NumPad3 = 99; VK_NumPad4 = 100;
VK_NumPad5 = 101; VK_NumPad6 = 102; VK_NumPad7 = 103;
VK_NumPad8 = 104; VK_NumPad9 = 105; VK_Multiply = 106;
VK_Add = 107; VK_Separator = 108; VK_Subtract = 109;
VK_Decimal = 110; VK_Divide = 111; VK_F1 = 112;
VK_F2 = 113; VK_F3 = 114; VK_F4 = 115;
VK_F5 = 116; VK_F6 = 117; VK_F7 = 118;
VK_F8 = 119; VK_F9 = 120; VK_F10 = 121;
VK_F11 = 122; VK_F12 = 123; VK_NumLock = 144;
VK_Scroll = 145; VK_LShiftKey = 160; VK_RShiftKey = 161;
VK_LControlKey = 162; VK_RControlKey = 163; VK_LMenu = 164;
VK_RMenu = 165;
VK_KeyCode = 65535; VK_Shift = 65536; VK_Control = 131072;
VK_Alt = 262144; VK_Modifiers = -65536;
type
/// Тип цвета.
TColor = Color;
/// Тип точки.
TPoint = Point;
/// Тип рисунка.
TPicture = Picture;
/// Тип массива точек.
TPointArray = array of TPoint;
/// Тип пера
TPen = GraphABCPen;
/// Тип кисти
TBrush = GraphABCBrush;
/// Тип кисти
TFont = GraphABCFont;
/// Центрирует окно.
procedure SetCenterOnScreen() := Window.CenterOnScreen();
/// Получает центр окна.
procedure GetWindowCenter() := WindowCenter();
/// Устанавливает заголовок окна.
procedure SetWindowCaption(obj: object) := SetWindowCaption(obj.ToString());
/// Получает заголовок окна.
procedure GetWindowCaption() := WindowCaption();
/// Устанавливает смещение окна.
procedure SetWindowPosition(p: TPoint) := SetWindowPos(p.X, p.Y);
/// Получает смещение окна.
procedure GetWindowPosition(p: TPoint) := new TPoint(WindowLeft(), WindowTop());
/// Максимизирует графическое окно.
procedure Maximize() := Window.Maximize();
/// Миниммизирует графическое окно.
procedure Minimize() := Window.Minimize();
//---------------------------------------------------------------------------
procedure SetPixel(x, y: real; c: TColor) := SetPixel(Round(x), Round(y), c);
procedure PutPixel(x, y: real; c: TColor) := SetPixel(x, y, c);
function GetPixel(x, y: real): TColor := GetPixel(Round(x), Round(y));
//---------------------------------------------------------------------------
procedure MoveTo(x, y: real) := MoveTo(Round(x), Round(y));
procedure LineTo(x,y: real) := LineTo(Round(x), Round(y));
procedure LineTo(x, y: real; c: TColor) := LineTo(Round(x), Round(y), c);
//---------------------------------------------------------------------------
procedure Line(x1, y1, x2, y2: real) := Line(Round(x1), Round(y1), Round(x2), Round(y2));
procedure Line(x1, y1, x2, y2: real; c: TColor) := Line(Round(x1), Round(y1), Round(x2), Round(y2), c);
procedure FillCircle(x, y, r: real) := FillCircle(Round(x), Round(y), Round(r));
procedure DrawCircle(x, y, r: real) := FillCircle(Round(x), Round(y), Round(r));
procedure FillEllipse(x1, y1, x2, y2: real) := FillEllipse(Round(x1), Round(y1), Round(x2), Round(y2));
procedure DrawEllipse(x1, y1, x2, y2: real) := DrawEllipse(Round(x1), Round(y1), Round(x2), Round(y2));
procedure FillRectangle(x1, y1, x2, y2: real) := FillRectangle(Round(x1), Round(y1), Round(x2), Round(y2));
procedure DrawRectangle(x1, y1, x2, y2: real) := DrawRectangle(Round(x1), Round(y1), Round(x2), Round(y2));
procedure FillRoundRect(x1, y1, x2, y2, w, h: real) := FillRoundRect(Round(x1), Round(y1), Round(x2), Round(y2), Round(w), Round(h));
procedure DrawRoundRect(x1, y1, x2, y2, w, h: real) := DrawRoundRect(Round(x1), Round(y1), Round(x2), Round(y2), Round(w), Round(h));
procedure Arc(x, y, r, a1, a2: real) := Arc(Round(x), Round(y), Round(r), Round(a1), Round(a2));
procedure FillPie(x, y, r, a1, a2: real) := FillPie(Round(x), Round(y), Round(r), Round(a1), Round(a2));
procedure DrawPie(x, y, r, a1, a2: real) := DrawPie(Round(x), Round(y), Round(r), Round(a1), Round(a2));
procedure Pie(x, y, r, a1, a2: real) := Pie(Round(x), Round(y), Round(r), Round(a1), Round(a2));
procedure TextOut<T>(x, y: real; obj: object) := TextOut(Round(x), Round(y), obj.ToString());
procedure DrawTextCentered<T>(x1, y1, x2, y2: real; obj: T) := DrawTextCentered(Round(x1), Round(y1), Round(x2), Round(y2), obj.ToString());
procedure FloodFill(x, y: real; c: TColor) := FloodFill(Round(x), Round(y), c);
//---------------------------------------------------------------------------
procedure Circle(x, y, r: real) := Circle(Round(x), Round(y), Round(r));
procedure Ellipse(x1, y1, x2, y2: real) := Ellipse(Round(x1), Round(y1), Round(x2), Round(y2));
procedure Rectangle(x1, y1, x2, y2: real) := Rectangle(Round(x1), Round(y1), Round(x2), Round(y2));
procedure RoundRectangle(x1, y1, x2, y2, w, h: real) := RoundRect(Round(x1), Round(y1), Round(x2), Round(y2), Round(w), Round(h));
//---------------------------------------------------------------------------
/// Рисует текст с тенью.
procedure DrawTextCentered<T>(x1, y1, x2, y2: real; obj: T; dispX, dispY: real; c1, c2: TColor);
begin
SetFontColor(c2);
DrawTextCentered(x1 + dispX, y1 + dispY, x2 + dispX, y2 + dispY, obj);
SetFontColor(c1);
DrawTextCentered(x1, y1, x2, y2, obj);
end;
end.
Математические инструменты движка
[править]Предоставляет классы векторов и матриц для использования как пользователем, так и движком.
/// Предоставляет некоторые базовые операции с векторами и матрицами.
unit MathUtils;
uses EngineExceptionsTypes;
type
IEquatable<T> = System.IEquatable<T>;
SerializableAttribute = System.SerializableAttribute;
type
[SerializableAttribute]
/// Класс двумерного вектора.
TVector2D = class(IEquatable<TVector2D>)
private
_X, _Y: real;
function GetLen() := Sqrt(Sqr(_X) + Sqr(_Y));
public
/// X координата вектора
property X: real read _X write _X;
/// Y координата вектора
property Y: real read _Y write _Y;
/// Длина вектора
property Len: real read GetLen;
constructor(cx, cy: real);
begin
X := cx;Y := cy;
end;
/// Возвращает скалярное произведение векторов.
function Mult(v: TVector2D) := _X * v.X + _Y * v.Y;
/// Возвращает true, если векторы являются коллинеарными (ни одна из координат векторов не должна равняться нулю).
function IsCollinear(v: TVector2D) := _X / v.X = _Y / v.Y;
class procedure operator *=(v: TVector2D; k: real);
begin
v.X *= k;
v.Y *= k;
end;
class procedure operator +=(v, v1: TVector2D);
begin
v.X += v1.X;
v.Y += v1.Y;
end;
/// Возвращает вектор i.
class function VectorI() := new TVector2D(1, 0);
/// Возвращает вектор j.
class function VectorJ() := new TVector2D(0, 1);
/// Возвращает вектор, получаемый суммированием всех векторов, указанных в параметрах.
class function VectorSum(vectors: array of TVector2D): TVector2D;
begin
Result := new TVector2D(0, 0);
foreach var vector in vectors do
Result := Result + vector;
end;
/// Читает вектор с клавиатуры.
class function Readln() := new TVector2D(ReadlnInteger('X:'), ReadlnInteger('Y:'));
class function operator *(v: TVector2D; k: real) := new TVector2D(v.X * k, v.Y * k);
class function operator +(v, v1: TVector2D) := new TVector2D(v.X + v1.X, v.Y + v1.Y);
class function operator-(a: TVector2D) := new TVector2D(-a.X, -a.Y); // Возвращает новый вектор с координатами (-X, -Y).
class function operator=(a, b: TVector2D) := (a.X = b.X) and (a.Y = b.Y);
class function operator<>(a, b: TVector2D) := not (a = b);
/// Возвращает строковое представление объекта.
function ToString() := Format('Vector({0}, {1})', _X, _Y);
/// Выводит строковое представление объекта.
procedure Print() := Write(ToString());
/// Выводит строковое представление объекта и переходит на новую строку.
procedure Println() := Writeln(ToString());
///Проверяет два вектора на равенство.
function Equals(v: TVector2D) := self = v;
end;
[SerializableAttribute]
/// Класс трехмерного вектора.
TVector3D = class(TVector2D)
private
_Z: real;
function GetLen() := Sqrt(Sqr(_X) + Sqr(_Y) + Sqr(_Z));
public
/// X координата вектора
property Z: real read _Z write _Z;
/// Длина вектора
property Len: real read GetLen;
constructor(cx, cy, cz: real);
begin
X := cx;Y := cy;Z := cz;
end;
/// Возвращает скалярное произведение векторов.
function Mult(v: TVector3D) := _X * v.X + _Y * v.Y + _Z * v.Z;
/// Возвращает векторное произведение векторов.
function VectorMult(v: TVector3D) := new TVector3D(_Y * v.Z - v.Y * _Z, -(_X * v.Z - v.X * _Z), _X * v.Y - v.X * _Y);
/// Читает вектор с клавиатуры.
class function Readln() := new TVector3D(ReadlnInteger('X:'), ReadlnInteger('Y:'), ReadlnInteger('Z:'));
/// Возвращает вектор k.
function VectorK() := new TVector3D(0, 0, 1);
/// Возвращает вектор, получаемый суммированием всех векторов, указанных в параметрах.
class function VectorSum(vectors: array of TVector3D): TVector3D;
begin
Result := new TVector3D(0, 0, 0);
foreach var vector in vectors do
Result := Result + vector;
end;
class procedure operator *=(v: TVector3D; k: real);
begin
v.X *= k;
v.Y *= k;
v.Z *= k;
end;
class procedure operator +=(v, v1: TVector3D);
begin
v.X += v1.X;
v.Y += v1.Y;
v.Z += v1.Z;
end;
class function operator *(v: TVector3D; k: real) := new TVector3D(v.X * k, v.Y * k, v.Z * k);
class function operator +(v, v1: TVector3D) := new TVector3D(v.X + v1.X, v.Y + v1.Y, v.Z + v1.Z);
class function operator-(a: TVector3D) := new TVector3D(-a.X, -a.Y, -a.Z);
class function operator=(a, b: TVector3D) := (a.X = b.X) and (a.Y = b.Y) and (a.Z = b.Z);
class function operator<>(a, b: TVector3D) := not (a = b);
/// Возвращает строковое представление объекта.
function ToString() := Format('Vector({0}, {1}, {2})', _X, _Y, _Z);
/// Выводит строковое представление объекта.
procedure Print() := Write(ToString());
/// Выводит строковое представление объекта и переходит на новую строку.
procedure Println() := Writeln(ToString());
///Проверяет два вектора на равенство.
function Equals(v: TVector3D) := self = v;
end;
type
[SerializableAttribute]
/// Класс матрицы.
TMatrix = class
private
_A: array [,] of real;
_RowsCount, _ColsCount: integer;
procedure TryRaiseInvalidSizeException(v: integer);
begin
if v <= 0 then
raise new InvalidSizeException('Недопустимое значение.');
end;
function GetItem(i, j: int64) := _A[i, j];
procedure SetItem(i, j: int64; v: real) := _A[i, j] := v;
procedure Resize() := SetLength(_A, _RowsCount, _ColsCount);
procedure SetRowsCount(v: integer);
begin
TryRaiseInvalidSizeException(v);
_RowsCount := v;
Resize();
end;
procedure SetColCount(v: integer);
begin
TryRaiseInvalidSizeException(v);
_ColsCount := v;
Resize();
end;
public
property Items[i, j: int64]: real read GetItem write SetItem;default;
/// Количество строк
property RowsCount: integer read _RowsCount write SetRowsCount;
/// Количество столбцов
property ColsCount: integer read _ColsCount write SetColCount;
constructor(rCount: integer := 3; cCount: integer := 3);
begin
RowsCount := rCount;
ColsCount := cCount;
Resize();
end;
/// Заполняет матрицу нулями и возвращает ссылку на нее.
function ToZero(): TMatrix;
begin
for var i := 0 to Pred(_RowsCount) do
for var j := 0 to Pred(_ColsCount) do
_A[i, j] := 0;
Result := self;
end;
/// Делает данную матрицу единичной и возвращает ссылку на нее.
function ToUnitMatrix(): TMatrix;
begin
ToZero();
for var i := 0 to Pred(_RowsCount) do
_A[i, i] := 1;
Result := self;
end;
/// Транспонирует матрицу.
function Transpose(): TMatrix;
begin
Result := new TMatrix(_ColsCount, _RowsCount);
for var i := 0 to Pred(_RowsCount) do
for var j := 0 to Pred(_ColsCount) do
Result[j, i] := _A[i, j];
end;
/// Изменяет размер матрицы, сохраняя отношение RowsCount / ColsCount.
function Resize(k: integer): TMatrix;
begin
TryRaiseInvalidSizeException(k);
_RowsCount *= k;
_ColsCount *= k;
Result := self;
end;
/// Возвращает копию матрицы.
function Copy(): TMatrix;
begin
Result := new TMatrix(_RowsCount, _ColsCount);
for var i := 0 to Pred(_RowsCount) do
for var j := 0 to Pred(_ColsCount) do
Result[i, j] := _A[i, j];
end;
/// Перемешивает матрицу случайным образом.
function Shuffle(): TMatrix;
begin
for var i := 0 to Pred(_RowsCount) do
for var j := 0 to _ColsCount - 2 do
Swap(_A[i, j], _A[i, Random(Succ(j), Pred(_ColsCount))]);
Result := self;
end;
/// Вычисляет алгебраическое дополнение и возвращает его в виде кортежа вида (integer, TMatrix).
function AlgebraicComplement(i, j: integer): (integer, TMatrix);
begin
var outcome := new TMatrix(Pred(_RowsCount), Pred(_ColsCount));
for var i1 := 0 to Pred(_RowsCount) do
for var j1 := 0 to Pred(_ColsCount) do
if (i1 <> i) and (j1 <> j) then
begin
var i2 := i1 - 1 * Ord(i1 > i);
var j2 := j1 - 1 * Ord(j1 > j);
outcome[i2, j2] := _A[i1, j1];
end;
Result := (1 - 2 * Ord((i + j) mod 2 <> 0), outcome);
end;
/// Читает матрицу с клавиатуры.
class function Readln(rCount, cCount: integer): TMatrix;
begin
Result := new TMatrix(rCount, cCount);
for var i := 0 to Pred(rCount) do
for var j := 0 to Pred(cCount) do
Result[i, j] := ReadlnInteger(Format('Value ({0}, {1}):', Succ(i), Succ(j)));;
end;
class procedure operator+=(m: TMatrix; k: integer);
begin
for var i := 0 to Pred(m.RowsCount) do
for var j := 0 to Pred(m.ColsCount) do
m[i, j] += k;
end;
class procedure operator-=(m: TMatrix; k: integer) := m += -k;
class procedure operator*=(m: TMatrix; k: integer);
begin
for var i := 0 to Pred(m.RowsCount) do
for var j := 0 to Pred(m.ColsCount) do
m[i, j] *= k;
end;
class procedure operator/=(m: TMatrix; k: integer);
begin
for var i := 0 to Pred(m.RowsCount) do
for var j := 0 to Pred(m.ColsCount) do
m[i, j] /= k;
end;
class function operator+(m: TMatrix; k: integer): TMatrix;
begin
Result := m.Copy();
Result += k;
end;
class function operator-(m: TMatrix; k: integer) := m + (-k);
class function operator*(m: TMatrix; k: integer): TMatrix;
begin
Result := m.Copy();
Result *= k;
end;
class function operator*(m1, m2: TMatrix): TMatrix; // Возвращает результат умножения матриц.
begin
Result := new TMatrix(m1.RowsCount, m2.ColsCount);
for var i := 0 to Pred(Result.RowsCount) do
for var j := 0 to Pred(Result.ColsCount) do
for var k := 0 to Pred(Result.RowsCount) do
Result[i, j] += m1[i, k] + m2[k, j];
end;
class function operator/(m: TMatrix; k: integer): TMatrix;
begin
Result := m.Copy();
Result /= k;
end;
class function operator-(m: TMatrix) := m * (-1);
class function operator=(m1, m2: TMatrix): boolean;
begin
if (m1.RowsCount <> m2.RowsCount) or (m1.ColsCount <> m2.ColsCount) then
raise new System.InvalidOperationException('Матрицы имеют различные размеры.');
Result := true;
for var i := 0 to Pred(m1.RowsCount) do
begin
for var j := 0 to Pred(m1.ColsCount) do
if m1[i, j] <> m2[i, j] then
begin
Result := false;
break;
end;
if not Result then break;
end;
end;
class function operator<>(m1, m2: TMatrix) := not (m1 = m2);
/// Возвращает строковое представление объекта.
function ToString() := Format('Matrix {0}x{1}', _RowsCount, _ColsCount);
/// Выводит строковое представление объекта.
function Print(): TMatrix;
begin
Write(ToString());
Result := self;
end;
/// Выводит строковое представление объекта и переходит на новую строку.
function Println(): TMatrix;
begin
Result := Print();
Write();
end;
/// Выводит содержимое матрицы.
function WritelnMatrix(width: integer := 4): TMatrix;
begin
for var i := 0 to Pred(_RowsCount) do
begin
for var j := 0 to Pred(_ColsCount) do
Write(_A[i, j]:width);
Writeln();
end;
Result := self;
end;
/// Проверяет две матрицы на равенство.
function Equals(m: TMatrix) := self = m;
end;
end.
Классы объектов движка
[править]Предоставляет классы игровых объектов.
/// Предоставляет классы игровых объектов.
unit GameObjectClasses;
uses System;
uses EngineExceptionsTypes, EventArgsTypes, BaseGraphSystem, MathUtils, Styles, GraphABC;
const
///Описание объекта по умолчанию.
DefaultDescription = 'game object';
type
[SerializableAttribute]
/// Главный класс игрового объекта.
TGameObject = class(ICloneable)
public
///Событие изменения свойства Description.
event OnDescriptionChanged: TPropertyChangedEventHandler;
private
_Description: string;
procedure SetDescription(v: string);
begin
if (v <> _Description) and (OnDescriptionChanged <> nil) then
OnDescriptionChanged(self, new TPropertyChangedEventArgs('Description', 'описание объекта'));
_Description := v;
end;
public
/// Предоставляет описание объекта
property Description: string read _Description write SetDescription;
constructor(d: string := DefaultDescription);
begin
Description := d;
end;
/// Возвращает строковое представление объекта.
function ToString() := Format('Description: {0}', _Description);
/// Выводит строковое представление объекта.
procedure Print() := Write(ToString());
/// Выводит строковое представление объекта и переходит на новую строку.
procedure Println() := Writeln(ToString());
///Клонирует объект.
function Clone(): object; virtual;
begin
var outcome := new TGameObject(_Description);
outcome.OnDescriptionChanged += OnDescriptionChanged;
Result := outcome;
end;
end;
[SerializableAttribute]
/// Главный класс видимого игрового объекта.
TVisibleGameObject = class(TGameObject)
public
///Событие изменения свойства IsVisible.
event OnIsVisibleChanged: TPropertyChangedEventHandler;
///Событие изменения свойства Style.
event OnStyleChanged: TPropertyChangedEventHandler;
///Событие изменения свойства PivotVector.
event OnPivotVectorChanged: TPropertyChangedEventHandler;
private
_IsVisible: boolean;
_Style: TStyle;
_PivotVector: TVector2D;
procedure SetIsVisible(v: boolean);
begin
if (v <> _IsVisible) and (OnIsVisibleChanged <> nil) then
OnIsVisibleChanged(self, new TPropertyChangedEventArgs('IsVisible', 'видимость объекта'));
_IsVisible := v;
end;
procedure SetStyle(v: TStyle);
begin
try
if (v <> _Style) and (OnStyleChanged <> nil) then
OnStyleChanged(self, new TPropertyChangedEventArgs('Style', 'стиль объекта'));
except on NullReferenceException do end;
_Style := v;
end;
procedure SetPivotVector(v: TVector2D);
begin
try
if (v <> _PivotVector) and (OnPivotVectorChanged <> nil) then
OnPivotVectorChanged(self, new TPropertyChangedEventArgs('PivotVector', 'радиус вектор, определяющий координаты центра объекта'));
except on NullReferenceException do end;
_PivotVector := v;
end;
protected
procedure SetStyleSettings() := _Style.SetDrawSettingsBySelf();
public
/// Видимость
property IsVisible: boolean read _IsVisible write SetIsVisible;
/// Стиль объекта
property Style: TStyle read _Style write SetStyle;
/// Вектор, определяющий координаты центра объекта
property PivotVector: TVector2D read _PivotVector write SetPivotVector;
constructor(d: string := DefaultDescription);
begin
inherited Create(d);
Style := new TStyle();
IsVisible := true;
end;
constructor(stl: TStyle; d: string := DefaultDescription);
begin
inherited Create(d);
Style := stl;
IsVisible := true;
end;
procedure Draw(); virtual;
begin
raise new NotImplementedException(NotImplementedExceptionText);
end;
procedure MoveOnVector(v: TVector2D) := _PivotVector += v;
/// Возвращает строковое представление объекта.
function ToString() := Format('IsVisible: {0}, Style: {1}, PivotVector: {2}', _IsVisible, _Style, _PivotVector);
/// Выводит строковое представление объекта.
procedure Print() := Write(ToString());
/// Выводит строковое представление объекта и переходит на новую строку.
procedure Println() := Writeln(ToString());
/// Клонирует объект.
function Clone(): object; override;
begin
var outcome := new TVisibleGameObject(_Style, _Description);
outcome.IsVisible := _IsVisible;
outcome.Style := _Style;
outcome.PivotVector := _PivotVector;
outcome.OnIsVisibleChanged += OnIsVisibleChanged;
outcome.OnStyleChanged += OnStyleChanged;
outcome.OnPivotVectorChanged += OnPivotVectorChanged;
Result := outcome;
end;
end;
type
[SerializableAttribute]
/// Класс объектов, основанных на форме прямоугольника.
TBox = class(TVisibleGameObject)
public
/// Событие наведения курсора мыши на объект.
event OnMouseOver: TMouseEventHandler;
///Событие изменения свойства Width.
event OnWidthChanged: TPropertyChangedEventHandler;
///Событие изменения свойства Height.
event OnHeightChanged: TPropertyChangedEventHandler;
private
_Width, _Height: real;
procedure SetWidth(v: real);
begin
if (v <> _Width) and (OnWidthChanged <> nil) then
OnWidthChanged(self, new TPropertyChangedEventArgs('Width', 'ширина объекта'));
_Width := v;
end;
procedure SetHeight(v: real);
begin
if (v <> _Height) and (OnHeightChanged <> nil) then
OnHeightChanged(self, new TPropertyChangedEventArgs('Height', 'высота объекта'));
_Height := v;
end;
public
/// Ширина
property Width: real read _Width write SetWidth;
/// Высота
property Height: real read _Height write SetHeight;
constructor(w, h: real; d: string := DefaultDescription);
begin
inherited Create(d);
Width := w;Height := h;
end;
/// Возвращает true, если точка лежит внутри прямоугольника или на его границе.
function PointInRectangle(p: TPoint): boolean;
begin
var (cx, cy) := (_PivotVector.X, _PivotVector.Y);
var (halfW, halfH) := (_Width / 2, _Height / 2);
Result := (p.X >= cx - halfW) and (p.Y >= cy - halfH) and (p.X <= cx + halfW) and (p.Y <= cy + halfH);
end;
///Пытается вызвать обработчик события MouseOver.
procedure TryMouseOver(mouseCoords: TPoint; mouseBtn: MouseButtonEnum; isUp: boolean);
begin
if (OnMouseOver <> nil) and PointInRectangle(mouseCoords) then
OnMouseOver(self, new TMouseEventArgs(mouseCoords.X, mouseCoords.Y, mouseBtn, isUp));
end;
/// Возвращает строковое представление объекта.
function ToString() := Format('Width: {0}, Height: {1}', _Width, _Height);
/// Выводит строковое представление объекта.
procedure Print() := Write(ToString());
/// Выводит строковое представление объекта и переходит на новую строку.
procedure Println() := Writeln(ToString());
/// Клонирует объект.
function Clone(): object; override;
begin
var outcome := TBox(inherited Clone());
outcome.Width := _Width;
outcome.Height := _Height;
outcome.OnMouseOver += OnMouseOver;
outcome.OnWidthChanged += OnWidthChanged;
outcome.OnHeightChanged += OnHeightChanged;
Result := outcome;
end;
end;
[SerializableAttribute]
/// Класс прямоугольника.
TRectangle = class(TBox)
public
/// Отрисовывает прямоугольник.
procedure Draw(); override;
begin
SetStyleSettings();
var (cx, cy) := (_PivotVector.X, _PivotVector.Y);
var (halfW, halfH) := (_Width / 2, _Height / 2);
Rectangle(cx - halfW, cy - halfH, cx + halfW, cy + halfH);
end;
end;
[SerializableAttribute]
/// Класс эллипса.
TEllipse = class(TBox)
public
/// Отрисовывает эллипс.
procedure Draw(); override;
begin
SetStyleSettings();
var (cx, cy) := (_PivotVector.X, _PivotVector.Y);
var (halfW, halfH) := (_Width / 2, _Height / 2);
Ellipse(cx - halfW, cy - halfH, cx + halfW, cy + halfH);
end;
end;
[SerializableAttribute]
/// Класс прямоугольника с текстом.
TTextBox = class(TRectangle)
public
///Событие изменения свойства UserText.
event OnUserTextChanged: TPropertyChangedEventHandler;
///Событие изменения свойства FontStyle.
event OnFontStyleChanged: TPropertyChangedEventHandler;
private
_UserText: string;
_FontStyle: TFontStyle;
procedure SetUserText(v: string);
begin
if (v <> _UserText) and (OnUserTextChanged <> nil) then
OnUserTextChanged(self, new TPropertyChangedEventArgs('UserText', 'текст на объекте'));
_UserText := v;
end;
procedure SetFontStyle(v: TFontStyle);
begin
if (v <> _FontStyle) and (OnFontStyleChanged <> nil) then
OnFontStyleChanged(self, new TPropertyChangedEventArgs('FontStyle', 'стиль текста на объекте'));
_FontStyle := v;
end;
protected
procedure SetFontSettings() := _FontStyle.SetFontSettingsBySelf();
public
/// Текст
property UserText: string read _UserText write SetUserText;
/// Стиль шрифта
property FontStyle: TFontStyle read _FontStyle write SetFontStyle;
constructor(w, h: real; fontS: TFontStyle; txt: string := '<None>'; d: string := DefaultDescription);
begin
inherited Create(w, h, d);
UserText := txt;
FontStyle := fontS;
end;
/// Отрисовывает прямоугольник с текстом.
procedure Draw(); override;
begin
inherited Draw();
SetFontSettings();
var (cx, cy) := (_PivotVector.X, _PivotVector.Y);
var (halfW, halfH) := (_Width / 2, _Height / 2);
DrawTextCentered(cx - halfW, cy - halfH, cx + halfW, cy + halfH, _UserText);
end;
/// Возвращает строковое представление объекта.
function ToString() := Format('UserText: {0}, FontStyle: {1}', _UserText, _FontStyle);
/// Выводит строковое представление объекта.
procedure Print() := Write(ToString());
/// Выводит строковое представление объекта и переходит на новую строку.
procedure Println() := Writeln(ToString());
/// Клонирует объект.
function Clone(): object; override;
begin
var outcome := TTextBox(inherited Clone());
outcome.UserText := _UserText;
outcome.FontStyle := _FontStyle;
outcome.OnUserTextChanged += OnUserTextChanged;
outcome.OnFontStyleChanged += OnFontStyleChanged;
Result := outcome;
end;
end;
[SerializableAttribute]
/// Класс отрезка.
TSegment = class(TBox)
public
/// Отрисовывает эллипс.
procedure Draw(); override;
begin
SetStyleSettings();
var (cx, cy) := (_PivotVector.X, _PivotVector.Y);
var (halfW, halfH) := (_Width / 2, _Height / 2);
Line(cx - halfW, cy - halfH, cx + halfW, cy + halfH);
end;
end;
/// Класс изображения.
TImage = class(TBox)
public
///Событие изменения свойства Image.
event OnImageChanged: TPropertyChangedEventHandler;
private
_Image: TPicture;
procedure SetImage(v: TPicture);
begin
try
if (v <> _Image) and (OnImageChanged <> nil) then
OnImageChanged(self, new TPropertyChangedEventArgs('Image', 'изображение на объекте'));
except on NullReferenceException do end;
_Image := v;
end;
public
/// Рисунок
property Image: TPicture read _Image write SetImage;
constructor(img: TPicture; d: string := DefaultDescription);
begin
inherited Create(img.Width, img.Width, d);
Image := img;
end;
/// Отрисовывает рисунок.
procedure Draw(); override;
begin
_Image.Draw(Round(_PivotVector.X - _Width / 2), Round(_PivotVector.Y - _Height / 2));
end;
/// Возвращает строковое представление объекта.
function ToString() := Format('Image: {0}', _Image.ToString());
/// Выводит строковое представление объекта.
procedure Print() := Write(ToString());
/// Выводит строковое представление объекта и переходит на новую строку.
procedure Println() := Writeln(ToString());
/// Клонирует объект.
function Clone(): object; override;
begin
var outcome := TImage(inherited Create(_Image.Width, _Image.Height, _Description));
outcome.Image := _Image;
outcome.OnImageChanged += OnImageChanged;
Result := outcome;
end;
end;
end.
Обработка ошибок
[править]/// Предоставляет классы исключений движка.
unit EngineExceptionsTypes;
uses System;
const
NotImplementedExceptionText = 'Реализация данного метода в данном классе отсутствует.';
type
[SerializableAttribute]
/// Исключение, выбрасываемое при неправильном размере матрицы.
InvalidSizeException = class(Exception)
constructor();
begin
end;
constructor(message: string);
begin
inherited Create(message);
end;
constructor(message: string; inner: Exception);
begin
inherited Create(message, inner);
end;
end;
end.
Ядро
[править]///Ядро игрового движка.
unit Main;
uses EventArgsTypes, BaseGraphSystem, MathUtils, Styles, GameObjectClasses, GraphABC;
type
///Главный класс игрового движка.
TEngine = sealed class
public
///Событие нажатия кнопки мыши.
class event OnMouseDownAction: TMouseEventHandler;
///Событие отжатия кнопки мыши.
class event OnMouseUpAction: TMouseEventHandler;
///Событие движения курсора.
class event OnMouseMoveAction: TMouseEventHandler;
///Событие нажатия клавиши.
class event OnKeyDownAction: TKeyboardEventHandler;
///Событие отжатия клавиши.
class event OnKeyUpAction: TKeyboardEventHandler;
///Вызывается перед перерисовкой всех объектов.
class PreDraw: Action0;
///Вызывается после отрисовки всех объектов.
class PostDraw: Action0;
private
class _Background: TColor;
class _GameObjects: List<TBox>;
class _FrameDrawTime: integer;
function GetGameObject(i: integer) := _GameObjects[i];
procedure SetGameObject(i: integer; obj: TBox) := _GameObjects[i] := obj;
function GetCount() := _GameObjects.Count;
public
class property Items[i: integer]: TBox read GetGameObject write SetGameObject;default;
/// Цвет фона
class property Background: TColor read _Background write _Background;
/// Количество объектов
class property Count: integer read GetCount;
/// Время, которое было затрачено на отрисовку последнего кадра
class property FrameDrawTime: integer read _FrameDrawTime;
class constructor();
begin
if _GameObjects = nil then
_GameObjects := new List<TBox>();
end;
///Добавляет объект в список объектов.
class procedure Add(obj: TBox) := _GameObjects.Add(obj);
///Удаляет объект из списока объектов.
class procedure Remove(obj: TBox) := _GameObjects.Remove(obj);
///Очищает список объектов.
class procedure Clear() := _GameObjects.Clear();
class procedure DrawAll();
begin
MillisecondsDelta();
lock _GameObjects do
begin
ClearWindow(_Background);
if PreDraw <> nil then PreDraw();
for var i := 0 to Pred(_GameObjects.Count) do
_GameObjects[i].Draw();
if PostDraw <> nil then PostDraw();
Redraw();
end;
_FrameDrawTime := MillisecondsDelta();
end;
class function ToEnum(mb: integer): MouseButtonEnum;
begin
case mb of
0: Result := MouseButtonEnum.None;
1: Result := MouseButtonEnum.Left;
2: Result := MouseButtonEnum.Right;
end;
end;
class procedure MouseDown(x, y, mb: integer);
begin
var btn := ToEnum(mb);
for var i := 0 to Pred(_GameObjects.Count) do
_GameObjects[i].TryMouseOver(new TPoint(x, y), btn, false);
if OnMouseDownAction <> nil then
OnMouseDownAction(Window(), new TMouseEventArgs(x, y, btn));
end;
class procedure MouseUp(x, y, mb: integer);
begin
var btn := ToEnum(mb);
for var i := 0 to Pred(_GameObjects.Count) do
_GameObjects[i].TryMouseOver(new TPoint(x, y), btn, true);
if OnMouseUpAction <> nil then
OnMouseUpAction(Window(), new TMouseEventArgs(x, y, btn, true));
end;
class procedure MouseMove(x, y, mb: integer);
begin
var btn := ToEnum(mb);
for var i := 0 to Pred(_GameObjects.Count) do
_GameObjects[i].TryMouseOver(new TPoint(x, y), btn, false); // Считаем, что неважно нажата ли или отжата кнопка мыши.
if OnMouseMoveAction <> nil then
OnMouseMoveAction(Window(), new TMouseEventArgs(x, y, btn));
end;
class procedure KeyDown(c: integer);
begin
if OnKeyDownAction <> nil then
OnKeyDownAction(Window(), new TKeyboardEventArgs(c));
end;
class procedure KeyUp(c: integer);
begin
if OnKeyUpAction <> nil then
OnKeyUpAction(Window(), new TKeyboardEventArgs(c));
end;
end;
/// [для внутренних нужд движка]
procedure __InitModule__();
begin
LockDrawing();
SetWindowIsFixedSize(true);
ClearWindow(clGray);
SetFontSize(50);
DrawTextCentered(0, 0, Window.Width, Window.Height, '2D Engine', 2, 1, clWhite, clBlack);
Redraw();
Sleep(2000);
ClearWindow();
OnMouseDown := TEngine.MouseDown;
OnMouseUp := TEngine.MouseUp;
OnMouseMove := TEngine.MouseMove;
OnKeyDown := TEngine.KeyDown;
OnKeyUp := TEngine.KeyUp;
end;
/// [для внутренних нужд движка]
procedure __FinalizeModule__();
begin
while true do
TEngine.DrawAll();
end;
initialization
__InitModule__();
finalization
__FinalizeModule__();
end.
Методы расширения
[править]///Расширяет функционал движка.
unit ExtensionMethods;
uses EventArgsTypes, BaseGraphSystem, MathUtils, Styles, GameObjectClasses, Main, GraphABC;
type
TDateTime = System.DateTime;
//---------------------------------------------------------------------------
// Основные методы
//---------------------------------------------------------------------------
///Возвращает площадь объекта.
function ObjectSquare(self: TBox): real; extensionmethod;
begin
Result := self.Width * self.Height;
end;
///Возвращает периметр объекта.
function ObjectPerimiter(self: TBox): real; extensionmethod;
begin
Result := 2 * (self.Width + self.Height);
end;
///Меняет местами два объекта.
procedure SwapPositions(self: TBox; a: TBox); extensionmethod;
begin
var (x1, y1) := (self.PivotVector.X, self.PivotVector.Y);
(self.PivotVector.X, self.PivotVector.Y) := (a.PivotVector.X, a.PivotVector.Y);
(a.PivotVector.X, a.PivotVector.Y) := (x1, y1);
end;
///Получает часть значения v, которая зависит от TEngine.FrameDrawTime.
function GetValueLinkedToTime(v: real) := v * TEngine.FrameDrawTime / 1000;
///Перемещение объекта на указанный вектор с учётом TEngine.FrameDrawTime.
procedure MoveOn(self: TBox; v: TVector2D); extensionmethod;
begin
self.PivotVector += new TVector2D(GetValueLinkedToTime(v.X), GetValueLinkedToTime(v.Y));
end;
//---------------------------------------------------------------------------
function InvertColor(c: TColor) := RGB(255 - c.R, 255 - c.G, 255 - c.B);
///Инвертирует цвет границы.
procedure InvertBorderColor(self: TStyle); extensionmethod;
begin
self.BorderColor := InvertColor(self.BorderColor);
end;
///Инвертирует цвет заливки.
procedure InvertFillColor(self: TStyle); extensionmethod;
begin
self.FillColor := InvertColor(self.FillColor);
end;
//---------------------------------------------------------------------------
///Возвращает первую координату вектора.
function FirstCoord(self: TVector2D): real; extensionmethod;
begin
Result := self.X;
end;
///Возвращает вторую координату вектора.
function LastCoord(self: TVector2D): real; extensionmethod;
begin
Result := self.Y;
end;
///Возвращает минимальную координату вектора.
function MinCoord(self: TVector2D): real; extensionmethod;
begin
Result := Min(self.X, self.Y);
end;
///Возвращает максимальую координату вектора.
function MaxCoord(self: TVector2D): real; extensionmethod;
begin
Result := Max(self.X, self.Y);
end;
///Возвращает минимальную координату вектора.
function MinCoord(self: TVector3D): real; extensionmethod;
begin
Result := Min(self.X, Min(self.Y, self.Z));
end;
///Возвращает максимальую координату вектора.
function MaxCoord(self: TVector3D): real; extensionmethod;
begin
Result := Max(self.X, Max(self.Y, self.Z));
end;
//---------------------------------------------------------------------------
///Возвращает первый элемент матрицы.
function First(self: TMatrix): real; extensionmethod;
begin
Result := self[0, 0];
end;
///Возвращает последний элемент матрицы.
function Last(self: TMatrix): real; extensionmethod;
begin
Result := self[Pred(self.RowsCount), Pred(self.ColsCount)];
end;
///Возвращает минимальный элемент матрицы.
function Min(self: TMatrix): real; extensionmethod;
begin
Result := integer.MaxValue;
for var i := 0 to Pred(self.RowsCount) do
for var j := 0 to Pred(self.ColsCount) do
if self[i, j] < Result then
Result := self[i, j];
end;
///Возвращает максимальный элемент матрицы.
function Max(self: TMatrix): real; extensionmethod;
begin
Result := integer.MinValue;
for var i := 0 to Pred(self.RowsCount) do
for var j := 0 to Pred(self.ColsCount) do
if self[i, j] > Result then
Result := self[i, j];
end;
///Возвращает среднее арифметическое элементов матрицы.
function Average(self: TMatrix): real; extensionmethod;
begin
for var i := 0 to Pred(self.RowsCount) do
for var j := 0 to Pred(self.ColsCount) do
Result += self[i, j];
Result /= self.RowsCount * self.ColsCount;
end;
/// Возвращает декартово произведение двух матриц в виде кортежей вида (real, real).
function Cartesian(self, m: TMatrix): sequence of (real, real); extensionmethod;
begin
for var i := 0 to Pred(self.RowsCount) do
for var j := 0 to Pred(self.ColsCount) do
for var i1 := 0 to Pred(m.RowsCount) do
for var j1 := 0 to Pred(m.ColsCount) do
yield (self[i, j], m[i1, j1]);
end;
//---------------------------------------------------------------------------
function Print_(self: TEventArgs): TEventArgs; extensionmethod;
begin
self.Print();
Result := self;
end;
function Println_(self: TEventArgs): TEventArgs; extensionmethod;
begin
self.Println();
Result := self;
end;
function Print_(self: TMouseEventArgs): TMouseEventArgs; extensionmethod;
begin
self.Print();
Result := self;
end;
function Println_(self: TMouseEventArgs): TMouseEventArgs; extensionmethod;
begin
self.Println();
Result := self;
end;
function Print_(self: TKeyboardEventArgs): TKeyboardEventArgs; extensionmethod;
begin
self.Print();
Result := self;
end;
function Println_(self: TKeyboardEventArgs): TKeyboardEventArgs; extensionmethod;
begin
self.Println();
Result := self;
end;
function Print_(self: TVector2D): TVector2D; extensionmethod;
begin
self.Print();
Result := self;
end;
function Println_(self: TVector2D): TVector2D; extensionmethod;
begin
self.Println();
Result := self;
end;
function Print_(self: TVector3D): TVector3D; extensionmethod;
begin
self.Print();
Result := self;
end;
function Println_(self: TVector3D): TVector3D; extensionmethod;
begin
self.Println();
Result := self;
end;
function Print_(self: TMatrix): TMatrix; extensionmethod;
begin
self.Print();
Result := self;
end;
function Println_(self: TMatrix): TMatrix; extensionmethod;
begin
self.Println();
Result := self;
end;
function Print_(self: TStyle): TStyle; extensionmethod;
begin
self.Print();
Result := self;
end;
function Println_(self: TStyle): TStyle; extensionmethod;
begin
self.Println();
Result := self;
end;
function Print_(self: TFontStyle): TFontStyle; extensionmethod;
begin
self.Print();
Result := self;
end;
function Println_(self: TFontStyle): TFontStyle; extensionmethod;
begin
self.Println();
Result := self;
end;
function Print_(self: TGameObject): TGameObject; extensionmethod;
begin
self.Print();
Result := self;
end;
function Println_(self: TGameObject): TGameObject; extensionmethod;
begin
self.Println();
Result := self;
end;
function Print_(self: TVisibleGameObject): TVisibleGameObject; extensionmethod;
begin
self.Print();
Result := self;
end;
function Println_(self: TVisibleGameObject): TVisibleGameObject; extensionmethod;
begin
self.Println();
Result := self;
end;
function Print_(self: TBox): TBox; extensionmethod;
begin
self.Print();
Result := self;
end;
function Println_(self: TBox): TBox; extensionmethod;
begin
self.Println();
Result := self;
end;
function Print_(self: TTextBox): TTextBox; extensionmethod;
begin
self.Print();
Result := self;
end;
function Println_(self: TTextBox): TTextBox; extensionmethod;
begin
self.Println();
Result := self;
end;
function Print_(self: TImage): TImage; extensionmethod;
begin
self.Print();
Result := self;
end;
function Println_(self: TImage): TImage; extensionmethod;
begin
self.Println();
Result := self;
end;
//---------------------------------------------------------------------------
///Записывает строку в файл.
procedure AssignAndWrite(t, path: string);
var
f: Text;
begin
Assign(f, path);
Append(f);
Write(f, t);
Close(f);
end;
///Записывает строковое представление объекта в файл.
procedure ToFile(self: TGameObject; path: string); extensionmethod;
begin
AssignAndWrite(self.ToString(), path);
end;
///Записывает строковое представление объекта в файл.
procedure ToFileln(self: TGameObject; path: string); extensionmethod;
begin
AssignAndWrite(self.ToString() + NewLine, path);
end;
///Записывает строковое представление объекта в файл.
procedure ToFile(self: TBox; path: string); extensionmethod;
begin
AssignAndWrite(self.ToString(), path);
end;
///Записывает строковое представление объекта в файл.
procedure ToFileln(self: TBox; path: string); extensionmethod;
begin
AssignAndWrite(self.ToString() + NewLine, path);
end;
///Записывает строковое представление объекта в файл.
procedure ToFile(self: TVisibleGameObject; path: string); extensionmethod;
begin
AssignAndWrite(self.ToString(), path);
end;
///Записывает строковое представление объекта в файл.
procedure ToFileln(self: TVisibleGameObject; path: string); extensionmethod;
begin
AssignAndWrite(self.ToString() + NewLine, path);
end;
///Записывает строковое представление объекта в файл.
procedure ToFile(self: TTextBox; path: string); extensionmethod;
begin
AssignAndWrite(self.ToString(), path);
end;
///Записывает строковое представление объекта в файл.
procedure ToFileln(self: TTextBox; path: string); extensionmethod;
begin
AssignAndWrite(self.ToString() + NewLine, path);
end;
///Записывает строковое представление объекта в файл.
procedure ToFile(self: TImage; path: string); extensionmethod;
begin
AssignAndWrite(self.ToString(), path);
end;
///Записывает строковое представление объекта в файл.
procedure ToFileln(self: TImage; path: string); extensionmethod;
begin
AssignAndWrite(self.ToString() + NewLine, path);
end;
//---------------------------------------------------------------------------
///Записывает строковое представление объекта в файл.
procedure ToFile(self: TVector2D; path: string); extensionmethod;
begin
AssignAndWrite(self.ToString(), path);
end;
///Записывает строковое представление объекта в файл.
procedure ToFileln(self: TVector2D; path: string); extensionmethod;
begin
AssignAndWrite(self.ToString() + NewLine, path);
end;
///Записывает строковое представление объекта в файл.
procedure ToFile(self: TVector3D; path: string); extensionmethod;
begin
AssignAndWrite(self.ToString(), path);
end;
///Записывает строковое представление объекта в файл.
procedure ToFileln(self: TVector3D; path: string); extensionmethod;
begin
AssignAndWrite(self.ToString() + NewLine, path);
end;
///Записывает строковое представление объекта в файл.
procedure ToFile(self: TMatrix; path: string); extensionmethod;
begin
AssignAndWrite(self.ToString(), path);
end;
///Записывает строковое представление объекта в файл.
procedure ToFileln(self: TMatrix; path: string); extensionmethod;
begin
AssignAndWrite(self.ToString() + NewLine, path);
end;
//---------------------------------------------------------------------------
///Записывает строковые представления нескольких объектов в файл.
procedure ToFileln(path: string; params objects: array of TBox);
begin
foreach var obj in objects do
obj.ToFileln(path);
end;
//---------------------------------------------------------------------------
// Конвертация типов
//---------------------------------------------------------------------------
/// Преобразовывает объект в кортеж (порядок элементов кортежа совпадает с порядком свойств в описании класса).
function ToTuple(self: TEventArgs): (TDateTime, boolean); extensionmethod;
begin
Result := (self.Time, self.IsUp);
end;
/// Преобразовывает объект в кортеж (порядок элементов кортежа совпадает с порядком свойств в описании класса).
function ToTuple(self: TMouseEventArgs): (TDateTime, boolean, integer, integer, MouseButtonEnum); extensionmethod;
begin
Result := (self.Time, self.IsUp, self.X, self.Y, self.MouseButton);
end;
/// Преобразовывает объект в кортеж (порядок элементов кортежа совпадает с порядком свойств в описании класса).
function ToTuple(self: TKeyboardEventArgs): (TDateTime, boolean, integer); extensionmethod;
begin
Result := (self.Time, self.IsUp, self.Code);
end;
/// Преобразовывает объект в кортеж (порядок элементов кортежа совпадает с порядком свойств в описании класса).
function ToTuple(self: TPropertyChangedEventArgs): (TDateTime, boolean, string, string); extensionmethod;
begin
Result := (self.Time, self.IsUp, self.Name, self.PropDescription);
end;
//---------------------------------------------------------------------------
/// Преобразовывает объект в кортеж (порядок элементов кортежа совпадает с порядком свойств в описании класса).
function ToTuple(self: TVector2D): (real, real); extensionmethod;
begin
Result := (self.X, self.Y);
end;
/// Преобразовывает объект в кортеж (порядок элементов кортежа совпадает с порядком свойств в описании класса).
function ToTuple(self: TVector3D): (real, real, real); extensionmethod;
begin
Result := (self.X, self.Y, self.Z);
end;
/// Возвращает матрицу, построенную по вектору.
function ToMatrix(self: TVector2D): TMatrix; extensionmethod;
begin
Result := new TMatrix(2, 1);
Result[0, 0] := self.X;
Result[1, 0] := self.Y;
end;
/// Возвращает матрицу, построенную по вектору.
function ToMatrix(self: TVector3D): TMatrix; extensionmethod;
begin
Result := new TMatrix(3, 1);
Result[0, 0] := self.X;
Result[1, 0] := self.Y;
Result[2, 0] := self.Z;
end;
end.
Пример
[править]Перемещение объекта клавиатурой
[править]//Пример движения объекта.
uses EventArgsTypes, BaseGraphSystem, MathUtils, Styles, GameObjectClasses, ExtensionMethods, Main;
const
Speed = 100;
var
Rect: TRectangle := new TRectangle(100, 100);
procedure KeyHandler(sender: object; e: TKeyboardEventArgs);
begin
case e.Code of
VK_Left: Rect.MoveOnVector(new TVector2D(-Speed, 0));
VK_Right: Rect.MoveOnVector(new TVector2D(Speed, 0));
VK_Down: Rect.MoveOnVector(new TVector2D(0, Speed));
VK_Up: Rect.MoveOnVector(new TVector2D(0, -Speed));
end;
end;
begin
Rect.PivotVector := new TVector2D(100, 100);
Rect.Style := new TStyle(); // Обязательно!
TEngine.Add(Rect);
TEngine.Background := clWhite; // Обязательно надо назначить какой либо цвет фону, только не clTransparent.
TEngine.OnKeyDownAction += KeyHandler;
end.
Изменение стиля
[править]//Пример изменения стиля.
uses Styles, BaseGraphSystem;
begin
DefaultObjectStyle.BorderColor := clRed;
DefaultObjectStyle.FillColor := clRed;
DefaultObjectStyle.BorderWidth := 2;
DefaultObjectStyle.Println();
end.
Запись объектов в файл
[править]//Пример записи строкового представления объекта в файл.
uses GameObjectClasses, ExtensionMethods, BaseGraphSystem;
begin
(new TRectangle(100, 100)).ToFileln('C:\Ilya\AlgoРитмы\Engine\Out.txt');
(new TImage(new TPicture('C:\Ilya\AlgoРитмы\Engine\pic.jpg'))).ToFileln('C:\Ilya\AlgoРитмы\Engine\Out.txt');
Writeln('Запись завершена.');
end.