administrator/pascalabcnet
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

fix pascalabcnet/pascalabcnetide#198

Browse source
This commit is contained in:
Бондарев Иван 2020-09-20 11:05:18 +02:00
parent db107c5ebf
commit 2e6e7b982a
25 changed files with 27736 additions and 3046 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
ParserTools/SyntaxTreeVisitors/SyntaxTreeComparer.cs
View file

@ -712,6 +712,10 @@ namespace PascalABCCompiler.SyntaxTree
CompareInternal(left as is_pattern_expr, right as is_pattern_expr);
else if (left is if_expr_new)
CompareInternal(left as if_expr_new, right as if_expr_new);
else if (left is dot_question_node)
CompareInternal(left as dot_question_node, right as dot_question_node);
else if (left is double_question_node)
CompareInternal(left as double_question_node, right as double_question_node);
else
throw new NotImplementedException(left.GetType().ToString());
@ -2362,5 +2366,27 @@ namespace PascalABCCompiler.SyntaxTree
CompareInternal(left.if_false, right.if_false);
}
}
public void CompareInternal(dot_question_node left, dot_question_node right)
{
if (left == null && right != null || left != null && right == null)
throw_not_equal(left, right);
if (left != null && right != null)
{
CompareInternal(left.left, right.left);
CompareInternal(left.right, right.right);
}
}
public void CompareInternal(double_question_node left, double_question_node right)
{
if (left == null && right != null || left != null && right == null)
throw_not_equal(left, right);
if (left != null && right != null)
{
CompareInternal(left.left, right.left);
CompareInternal(left.right, right.right);
}
}
}
}

2
TestSuite/formatter_tests/input/ABCHouse.pas
View file

@ -1,3 +1,5 @@
// Copyright (c) Ivan Bondarev, Stanislav Mikhalkovich (for details please see \doc\copyright.txt)
// This code is distributed under the GNU LGPL (for details please see \doc\license.txt)
unit ABCHouse;
interface

189
TestSuite/formatter_tests/input/ABCObjects.pas
View file

@ -1,3 +1,6 @@
// Copyright (c) Ivan Bondarev, Stanislav Mikhalkovich (for details please see \doc\copyright.txt)
// This code is distributed under the GNU LGPL (for details please see \doc\license.txt)
///Модуль реализует векторные графические объекты с возможностью масштабирования, наложения друг на друга,
///создания составных графических объектов и многократного их вложения друг в друга.
///Каждый векторный графический объект перерисовывает себя при перемещении, изменении размеров
@ -5,8 +8,8 @@
unit ABCObjects;
//{$apptype windows}
{$reference 'System.Windows.Forms.dll'}
{$reference 'System.Drawing.dll'}
{$reference '%GAC%\System.Windows.Forms.dll'}
{$reference '%GAC%\System.Drawing.dll'}
{$gendoc true}
interface
@ -14,6 +17,7 @@ interface
uses System.Drawing, GraphABC;
type
Color = GraphABC.Color;
GColor = GraphABC.Color;
ContainerABC = class;
GRectangle = System.Drawing.Rectangle;
@ -108,7 +112,7 @@ type
property Top: integer read fy write SetY;
/// Ширина графического объекта
property Width: integer read fw write SetWidth;
/// Высота графического объекта
/// Высота графического объекта
property Height: integer read fh write SetHeight;
///x-координата вектора перемещения объекта при вызове метода Move.
///По умолчанию установлено в 0. Для неподвижных объектов может быть использовано
@ -640,7 +644,7 @@ function ObjectsCount: integer;
function ObjectUnderPoint(x,y: integer): ObjectABC;
/// Графический объект под точкой p
function ObjectUnderPoint(p: Point): ObjectABC;
/// Поменять позиции графических олбъектов o1 и o2
/// Поменять позиции графических объектов o1 и o2
procedure SwapPositions(o1,o2: ObjectABC);
/// Элемент управления ABCObject под точкой (x,y)
@ -663,43 +667,9 @@ var
__LockDrawingObjects: boolean;
tempbmp: Bitmap;
function min(a,b: integer): integer;
begin
if a<b then
Result := a
else Result := b
end;
function max(a,b: integer): integer;
begin
if a>b then
Result := a
else Result := b
end;
function min(a,b: real): real;
begin
if a<b then
Result := a
else Result := b
end;
function max(a,b: real): real;
begin
if a>b then
Result := a
else Result := b
end;
procedure drawRect(r: GRectangle);
// Низкоуровневая процедура (не вызывается пользователем). Вызывает безусловную перерисовку прямоугольника.
var
/// b: Picture;
i: integer;
g: ObjectABC;
gb: System.Drawing.Graphics;
db: boolean;
bmp,bmp1,tb: Bitmap;
rr,rtmp: System.Drawing.Rectangle;
begin
LockGraphics;
@ -713,39 +683,39 @@ begin
if r.Height<=0 then
r.Height := 1;
bmp := GraphBufferBitmap;
var bmp := GraphBufferBitmap;
rr := new System.Drawing.Rectangle(r.Left,r.Top,r.Right-r.Left,r.Bottom-r.Top);
rtmp := new System.Drawing.Rectangle(0,0,r.Right-r.Left,r.Bottom-r.Top);
//tb := new Bitmap(r.Right-r.Left,r.Bottom-r.Top);
tb := GetView(tempbmp,rtmp);
var tb := GetView(tempbmp,rtmp);
gb := System.Drawing.Graphics.FromImage(tb);
var gb := System.Drawing.Graphics.FromImage(tb);
gb.SmoothingMode := GraphWindowGraphics.SmoothingMode;
// gb.TextRenderingHint := System.Drawing.Text.TextRenderingHint.AntiAlias;
bmp1 := GetView(bmp,rr);
var bmp1 := GetView(bmp,rr);
gb.DrawImageUnscaled(bmp1,0,0);
//gb.Transform := GraphWindowGraphics.Transform; // ???
bmp1.Dispose;
bmp1 := nil;
for i:=0 to __l.Count-1 do
for var i:=0 to __l.Count-1 do
begin
g := ObjectABC(__l[i]);
var g := ObjectABC(__l[i]);
if g.Visible and g.IntersectRect(r) then
g.Draw(g.Left-r.Left,g.Top-r.Top,gb);
end;
for i:=0 to __lUI.Count-1 do
for var i:=0 to __lUI.Count-1 do
begin
g := ObjectABC(__lUI[i]);
var g := ObjectABC(__lUI[i]);
if g.Visible and g.IntersectRect(r) then
g.Draw(g.Left-r.Left,g.Top-r.Top,gb);
end;
db := DrawInBuffer;
DrawInBuffer := False;
//var db := DrawInBuffer;
//DrawInBuffer := False;
// if not __LockDrawingObjects then
//var m := GraphWindowGraphics.Transform; // ???
@ -753,7 +723,9 @@ begin
GraphWindowGraphics.DrawImage(tb,r.Left,r.Top);
//GraphWindowGraphics.Transform := m; // ???
/// b.Draw(r.Left,r.Top);
DrawInBuffer := db;
//DrawInBuffer := db;
tb.Dispose;
tb := nil;
gb.Dispose;
gb := nil;
UnLockGraphics;
@ -818,14 +790,11 @@ begin
end;
function ObjectUnderPoint(x,y: integer): ObjectABC;
var
i: integer;
g: ObjectABC;
begin
Result:=nil;
for i := Objects.Count-1 downto 0 do
for var i := Objects.Count-1 downto 0 do
begin
g := Objects[i];
var g := Objects[i];
if g.PtInside(x,y) then
begin
Result:=g;
@ -848,14 +817,11 @@ begin
end;
function UIElementUnderPoint(x,y: integer): UIElementABC;
var
i: integer;
g: UIElementABC;
begin
Result:=nil;
for i:=__lUI.Count-1 downto 0 do
for var i:=__lUI.Count-1 downto 0 do
begin
g := UIElementABC(__lUI[i]);
var g := UIElementABC(__lUI[i]);
if g.PtInside(x,y) then
begin
Result := g;
@ -942,7 +908,32 @@ begin
newBounds.Offset(l,t);
if oldBounds.IntersectsWith(newBounds) then
begin
// Грубое решение проблемы неотрисовки части изображения
var rDiff := newBounds.Right - oldBounds.Right;
if rDiff > 0 then
newBounds.Width += rDiff;
var bDiff := newBounds.Bottom - oldBounds.Bottom;
if bDiff > 0 then
newBounds.Height += bDiff;
var xDiff := oldBounds.X - newBounds.X;
if xDiff > 0 then
begin
newBounds.X -= xDiff;
newBounds.Width += xDiff;
end;
var yDiff := oldBounds.Y - newBounds.Y;
if yDiff > 0 then
begin
newBounds.y -= yDiff;
newBounds.Height += yDiff;
end;
r := GRectangle.Union(oldBounds,newBounds);
//DrawRectangle(r.X,r.Y,r.Right,r.Bottom);
//TextOut(0,0,r.ToString);
//r.Width := r.Width + 5;
drawRect(r);
end
else
@ -1770,18 +1761,15 @@ begin
end;
procedure RegularPolygonABC.Draw(x,y: integer; g: Graphics);
var
i,r,z,x0,y0: integer;
phi: real;
begin
SetDrawSettings;
phi := -90 + Angle;
z := BorderWidth div 2;
r := Width div 2;
var phi := -90 + Angle;
var z := BorderWidth div 2;
var r := Width div 2;
r := r - z;
x0 := x + Width div 2;
y0 := y + Width div 2;
for i:=0 to n-1 do
var x0 := x + Width div 2;
var y0 := y + Width div 2;
for var i:=0 to n-1 do
begin
a[i].x := round(r*cos(phi*Pi/180)) + x0;
a[i].y := round(r*sin(phi*Pi/180)) + y0;
@ -1964,7 +1952,7 @@ end;
procedure StarABC.Draw(x,y: integer; g: Graphics);
var
i,r,rr,z,x0,y0: integer;
r,rr,z,x0,y0: integer;
phi: real;
begin
SetDrawSettings;
@ -1975,7 +1963,7 @@ begin
x0 := x + Width div 2;
y0 := y + Width div 2;
rr := round(r/r_rr);
for i:=0 to Count*2-1 do
for var i:=0 to Count*2-1 do
begin
if i mod 2 = 0 then
begin
@ -2375,15 +2363,12 @@ begin
end;
procedure ContainerABC.InitBy(g: ContainerABC);
var
i: integer;
ob: ObjectABC;
begin
l := new System.Collections.ArrayList;
inherited InitBy(g);
for i:=0 to g.Count-1 do
for var i:=0 to g.Count-1 do
begin
ob := g[i].Clone0;
var ob := g[i].Clone0;
ob.Owner := Self;
end;
end;
@ -2430,14 +2415,11 @@ begin
end;
procedure ContainerABC.Draw(x,y: integer; g: Graphics);
var
i: integer;
ob: ObjectABC;
begin
LockGraphics;
for i:=0 to l.Count-1 do
for var i:=0 to l.Count-1 do
begin
ob := ObjectABC(l[i]);
var ob := ObjectABC(l[i]);
if ob.Visible then
ob.Draw(x+ob.Left,y+ob.Top,g);
end;
@ -2445,14 +2427,11 @@ begin
end;
function ContainerABC.PtInside(x,y:integer): boolean;
var
i: integer;
g: ObjectABC;
begin
Result:=False;
for i:=0 to l.Count-1 do
for var i:=0 to l.Count-1 do
begin
g := ObjectABC(l[i]);
var g := ObjectABC(l[i]);
if g.PtInside(x-Left,y-Top) then
begin
Result := True;
@ -2462,17 +2441,13 @@ begin
end;
procedure ContainerABC.SetWidth(Width: integer);
var
i: integer;
scale: real;
g: ObjectABC;
begin
if Self.Width = 0 then
Exit;
scale := Width/Self.Width;
for i:=0 to l.Count-1 do
var scale := Width/Self.Width;
for var i:=0 to l.Count-1 do
begin
g := ObjectABC(l[i]);
var g := ObjectABC(l[i]);
g.Left := round(g.Left*scale);
g.Width := round(g.Width*scale);
end;
@ -2480,16 +2455,12 @@ begin
end;
procedure ContainerABC.SetHeight(Height: integer);
var
i: integer;
scale: real;
g: ObjectABC;
begin
if Self.Height=0 then Exit;
scale:=Height/Self.Height;
for i:=1 to l.Count do
var scale:=Height/Self.Height;
for var i:=1 to l.Count do
begin
g := ObjectABC(l[i]);
var g := ObjectABC(l[i]);
g.Top := round(g.Top*scale);
g.Height := round(g.Height*scale);
end;
@ -2497,19 +2468,16 @@ begin
end;
procedure ContainerABC.RecalcBounds;
var
i: integer;
r: GRectangle;
begin
if Count=0 then Exit;
r := ObjectABC(l[0]).Bounds;
for i:=1 to l.Count-1 do
var r := ObjectABC(l[0]).Bounds;
for var i:=1 to l.Count-1 do
r := GRectangle.Union(r,ObjectABC(l[i]).Bounds);
fx := fx + r.Left;
fy := fy + r.Top;
fw := r.Right - r.Left;
fh := r.Bottom - r.Top;
for i:=0 to l.Count-1 do
for var i:=0 to l.Count-1 do
ObjectABC(l[i]).SetCoords(ObjectABC(l[i]).Left-r.Left,ObjectABC(l[i]).Top-r.Top);
end;
@ -2610,14 +2578,13 @@ begin
end;
procedure BoardABC.Draw(x,y: integer; g: Graphics);
var i: integer;
begin
SetDrawSettings;
LockGraphics;
FillRectangle(x,y,x+Width,y+Height,g);
for i:=0 to nx do
for var i:=0 to nx do
Line(x+i*szx,y,x+i*szx,y+Height-1,g);
for i:=0 to ny do
for var i:=0 to ny do
Line(x,y+i*szy,x+Width-1,y+i*szy,g);
UnLockGraphics;
end;
@ -2634,20 +2601,18 @@ end;
//------ ObjectBoardABC ------
procedure ObjectBoardABC.Init(x,y,nn,mm,sszx,sszy: integer; cl: GColor);
var i: integer;
begin
inherited Init(x,y,nn,mm,sszx,sszy,cl);
SetLength(ar,nn*mm);
for i:=0 to nn*mm-1 do
for var i:=0 to nn*mm-1 do
ar[i] := nil;
end;
procedure ObjectBoardABC.InitBy(g: ObjectBoardABC);
var i: integer;
begin
inherited InitBy(g);
SetLength(ar,g.ar.Length);
for i:=0 to g.ar.Length-1 do
for var i:=0 to g.ar.Length-1 do
ar[i] := g.ar[i].Clone;
end;

3
TestSuite/formatter_tests/input/ABCSprites.pas
View file

@ -1,3 +1,6 @@
// Copyright (c) Ivan Bondarev, Stanislav Mikhalkovich (for details please see \doc\copyright.txt)
// This code is distributed under the GNU LGPL (for details please see \doc\license.txt)
///Модуль ABCSprites реализует спрайты - анимационные объекты с автоматически меняющимися кадрами.
///Спрайт представляется классом SpriteABC и является разновидностью мультикартинки MultiPictureABC.
unit ABCSprites;

190
TestSuite/formatter_tests/input/BBCMicrobit.pas Normal file
View file

@ -0,0 +1,190 @@
// BBC Micro:bit communication module
unit BBCMicrobit;
interface
/// Исключение для информирования об отсутствии подключенного устройства
type
NoUBSComPortsException = class(Exception) end;
NoBBCBoardFoundException = class(Exception) end;
/// Класс для взаимодействия с устройством BBC Micro:bit
type
Microbit = class(System.IDisposable)
protected
/// Порт для связи с устройством
Port: System.IO.Ports.SerialPort;
/// Обработчик данных от платы. Принимает только строки
procedure DataReceivedHandler(sender: object; e: System.IO.Ports.SerialDataReceivedEventArgs);
public
/// Копирование файла прошивки в BBC:Microbit
class procedure CopyFile(filename : string);
public
/// Обработчик события распознавания
OnReadString: procedure(Message: string);
/// Список USB COM-портов с идентификаторами Microbit
class function GetUsbPortNames: List<string>;
begin
// Вот такие параметры у каждой платы (по крайней мере сейчас)
var pattern := '^VID_0D28.PID_0204';
var _rx := new System.Text.RegularExpressions.Regex(pattern, RegexOptions.IgnoreCase);
Result := new List<string>;
var {Microsoft.Win32.RegistryKey} rk1 := Microsoft.Win32.Registry.LocalMachine;
var {Microsoft.Win32.RegistryKey} rk2 := rk1.OpenSubKey('SYSTEM\\CurrentControlSet\\Enum');
foreach s3: string in rk2.GetSubKeyNames do
begin
var rk3 := rk2.OpenSubKey(s3);
foreach s: string in rk3.GetSubKeyNames do
if _rx.Match(s).Success then
begin
var {RegistryKey} rk4 := rk3.OpenSubKey(s);
foreach s2: string in rk4.GetSubKeyNames do
begin
var {RegistryKey} rk5 := rk4.OpenSubKey(s2);
var {RegistryKey} rk6 := rk5.OpenSubKey('Device Parameters');
var {string} portName := string(rk6.GetValue('PortName'));
if not String.IsNullOrEmpty(portName) and System.IO.Ports.SerialPort.GetPortNames.Contains(portName) then
begin
Result.Add(string(rk6.GetValue('PortName')));
end;
end;
end;
end;
end;
/// <summary>
/// Конструктор объекта для взаимодействия с Microbit
/// </summary>
/// <param name="Handler">Процедура-обработчик, вызываемая для каждой принятой строки</param>
/// <param name="PortName">Имя COM-порта, можно не указывать</param>
constructor Create(Handler: procedure(s: string) := nil; PortName: string := '');
begin
OnReadString := Handler;
// Инициализируем виртуальный COM-порт, который связан с USB-устройством.
Port := new System.IO.Ports.SerialPort;
if PortName.Length > 0 then
// Порт указан явно при создании объекта класса, значит его и используем
Port.PortName := PortName
else
begin
// Порт явно не указан, приходится искать самостоятельно
// Получаем список всех похожих COM-портов (по VID и PID)
var portNames := GetUsbPortNames;
// Если подходящих портов нет - выбрасываем исключение
if portNames.Count = 0 then
raise new NoUBSComPortsException('Не найдено устройство Microbit')
else
// Берём первый попавшийся. Если устройств несколько, то надо явно указывать
Port.PortName := portNames[0];
end;
// Эти параметры зашиты явно, рекомендованы руководством по Microbit
Port.BaudRate := 115200; //Указываем скорость.
Port.DataBits := 8;
Port.Parity := System.IO.Ports.Parity.None;
Port.StopBits := System.IO.Ports.StopBits.One;
Port.DataReceived += DataReceivedHandler;
Port.Open; //Открываем порт
end;
/// Отправка строки на устройство Microbit
procedure Send(message: string) := Port.WriteLine(message);
/// Деструктор - закрывает COM-порт
destructor Destroy;
begin
if Port <> nil then
begin
Port.Close;
Port := nil;
end;
end;
procedure Dispose;
begin
Destroy;
end;
procedure Finalize; override;
begin
Destroy
end;
end;
implementation
/// Иногда строки приходят "склеенные" – нужно разбить по служебным символам
/// Эта функция возвращает первую группу символов из строки, ограниченную
/// служебными #10 или #13, сама подстрока из строки удаляется.
function ParseStr(var s : string) : string;
begin
var iStart := 1;
var len := s.Length;
while (iStart<=len) and ((s[iStart] = #10) or (s[iStart] = #13)) do
iStart += 1;
var iEnd := iStart + 1;
while (iEnd<=len) and (s[iEnd] <> #10) and (s[iEnd] <> #13) do
iEnd += 1;
// Копируем фрагмент, но с проверкой
if iEnd-iStart > 0 then
Result := copy(s, iStart, iEnd-iStart)
else
Result := '';
while (iEnd<len) and ((s[iEnd+1] = #10) or (s[iEnd+1] = #13)) do
iEnd += 1;
Delete(s,1,iEnd);
end;
procedure Microbit.DataReceivedHandler(sender: object; e: System.IO.Ports.SerialDataReceivedEventArgs);
begin
var sp := sender as System.IO.Ports.SerialPort;
// Читаем строку по ReadLine
var message := sp.ReadLine;
while message.Length > 0 do
begin
// Очередная подстрока
var block := ParseStr(message).TrimEnd(' ');
if (block.Length > 0) and (OnReadString <> nil) then
OnReadString(block);
end;
end;
class procedure MicroBit.CopyFile(filename : string);
begin
var allDrives := System.IO.DriveInfo.GetDrives();
foreach d: System.IO.DriveInfo in allDrives do
begin
if d.IsReady then
if d.VolumeLabel = 'MICROBIT' then
begin
var dest : string := d.RootDirectory.ToString + '\\' + System.IO.Path.GetFileName(filename);
System.IO.File.Copy(filename, dest);
sleep(2000);
exit;
end;
end;
raise new NoBBCBoardFoundException('Не найдено устройство Microbit');
end;
end.

754
TestSuite/formatter_tests/input/BlockFileOfT.pas
View file

File diff suppressed because it is too large Load diff

197
TestSuite/formatter_tests/input/DrawManField.pas
View file

@ -1,3 +1,5 @@
// Copyright (c) Ivan Bondarev, Stanislav Mikhalkovich (for details please see \doc\copyright.txt)
// This code is distributed under the GNU LGPL (for details please see \doc\license.txt)
unit DrawManField;
//#savepcu false
@ -23,6 +25,17 @@ var
ZazY1 := 5;
ZazX2 := 10;
ZazY2 := 16;
HelpStr := 'Разработчик исполнителя Чертежник: Михалкович С.С., 2002-17 '#10#13#10#13+
'Команды исполнителя Чертежник:'#10#13+
' PenDown - опустить перо'#10#13+
' PenUp - поднять перо'#10#13
' ToPoint(x,y) - переместиться в точку с координатами (x,y)'#10#13+
' OnVector(a,b) - переместиться из текущей точки на вектор (a,b)'#10#13
' a>0 - вправо, a<0 - влево, b>0 - вверх, b<0 - вниз'#10#13
' Task(name) - вызвать задание с указанным именем'#10#13
' StandardField - вызвать стандартное поле'#10#13
' Field(n,m) - вызвать поле размера n на m'#10#13#10#13;
type
TDMField = class
@ -42,6 +55,7 @@ type
procedure DrawFieldOnly;
procedure DrawXY;
public
dmwidth := 2;
// Добавил - МА
TaskName: string;
//
@ -68,6 +82,8 @@ type
procedure MakerPenDown;
procedure MakerToPoint(x,y: integer);
procedure MakerOnVector(x,y: integer);
procedure SetDrawManWidth(w: integer);
// примитивы для выполнителя
procedure DrawDM;
@ -215,16 +231,14 @@ begin
end;
procedure TDMField.DrawDMDrawing;
var i: integer;
begin
for i:=0 to DMColl.Count-1 do
for var i:=0 to DMColl.Count-1 do
DMLine(DMColl[i].p.x,DMColl[i].p.y,DMColl[i].p.x+DMColl[i].v.x,DMColl[i].p.y+DMColl[i].v.y,colorSolve);
end;
procedure TDMField.DrawDMMakerDrawing;
var i: integer;
begin
for i:=0 to DMMakerColl.Count-1 do
for var i:=0 to DMMakerColl.Count-1 do
DMLine(DMMakerColl[i].p.x,DMMakerColl[i].p.y,DMMakerColl[i].p.x+DMMakerColl[i].v.x,DMMakerColl[i].p.y+DMMakerColl[i].v.y,colorTask);
end;
@ -241,17 +255,16 @@ begin
end;
procedure TDMField.DrawFieldOnly;
var ix,iy,w,h: integer;
begin
w := CellSize*DimX;
h := CellSize*DimY;
var w := CellSize*DimX;
var h := CellSize*DimY;
Brush.Color := clWhite;
FillRectangle(X0,Y0,X0+ZazX1+w+1+ZazX2,Y0+ZazY1+h+1+ZazY2);
Pen.Width := 1;
Pen.Color := RGB(191,191,191);
for ix:=0 to DimX do
for var ix:=0 to DimX do
Line(X0+ZazX1+ix*CellSize,Y0+ZazY1,X0+ZazX1+ix*CellSize,Y0+ZazY1+h);
for iy:=0 to DimY do
for var iy:=0 to DimY do
Line(X0+ZazX1,Y0+ZazY1+iy*CellSize,X0+ZazX1+w,Y0+ZazY1+iy*CellSize);
Pen.Color := clGray;
if (orx>-DimX) and (orx<0) then
@ -264,7 +277,7 @@ begin
end;
procedure TDMField.DrawXY;
var x,y,ww: integer;
var ww: integer;
s: string;
interval: integer;
bs: BrushStyleType;
@ -281,7 +294,7 @@ begin
Brush.Style := bsClear;
Font.Name := 'MS Sans Serif';
Font.Size := 8;
for x:=0 to DimX do
for var x:=0 to DimX do
if (x+orx) mod interval = 0 then
begin
s:=IntToStr(x+orx);
@ -289,7 +302,7 @@ begin
// hh:=Canvas.TextHeight(s);
TextOut(X0+ZazX1+x*CellSize-ww div 2+1,Y0+ZazY1+DimY*CellSize+1+2,s);
end;
for y:=0 to DimY do
for var y:=0 to DimY do
if (y+ory) mod interval = 0 then
begin
s:=IntToStr(y+ory);
@ -304,6 +317,7 @@ end;
procedure TDMField.DMLine(x1,y1,x2,y2: integer; c: GraphABC.Color);
begin
Pen.Width := dmwidth;
Line(X0+ZazX1+(x1-orx)*CellSize,Y0+ZazY1+(DimY-y1+ory)*CellSize,X0+ZazX1+(x2-orx)*CellSize,Y0+ZazY1+(DimY-y2+ory)*CellSize,c);
end;
@ -362,6 +376,11 @@ begin
MakerToPoint(MakerX+x,MakerY+y);
end;
procedure TDMField.SetDrawManWidth(w: integer);
begin
dmwidth := 2;
end;
procedure TDMField.DrawDM;
var
ZZ: integer;
@ -374,6 +393,7 @@ begin
r1 := r;
r1.Offset(X0+ZazX1+(DMX-orx)*CellSize-4+1,Y0+ZazY1+(DimY-DMY+ory)*CellSize-4+1);
DMPicture.CopyRect(r,GraphBufferBitmap,r1);
Pen.Width := 1;
DrawRectangle(X0+ZazX1+(DMX-orx)*CellSize-ZZ+1,Y0+ZazY1+(DimY+ory-DMY)*CellSize-ZZ+1,X0+ZazX1+(DMX-orx)*CellSize+ZZ,Y0+ZazY1+(DimY+ory-DMY)*CellSize+ZZ);
end;
@ -567,6 +587,8 @@ end;
procedure buttonStartClick(o: Object; e: EventArgs);
begin
if t=nil then
exit;
if t.ThreadState = System.Threading.ThreadState.Suspended then
begin
DMField.StepFlag := False;
@ -584,6 +606,8 @@ end;
procedure buttonStepClick(o: Object; e: EventArgs);
begin
if t=nil then
exit;
DMField.StepFlag := True;
t.Resume;
(GraphABCControl as Control).Focus;
@ -592,18 +616,7 @@ end;
procedure buttonHelpClick(o: Object; e: EventArgs);
begin
MessageBox.Show('Разработчик исполнителя Чертежник: Михалкович С.С., 2002-07 '#10#13#10#13+
'Команды исполнителя Чертежник:'#10#13+
' PenDown - опустить перо'#10#13+
' PenUp - поднять перо'#10#13
' ToPoint(x,y) - переместиться в точку с координатами (x,y)'#10#13+
' OnVector(a,b) - переместиться из текущей точки на вектор (a,b)'#10#13
' a>0 - вправо, a<0 - влево, b>0 - вверх, b<0 - вниз'#10#13
' Speed(n) - установить скорость n (n=0..10)'#10#13
' Stop - остановить Чертежника'#10#13
' Start - запустить Чертежника'#10#13,
'Исполнитель Чертежник - Справка');
MessageBox.Show(HelpStr,'Исполнитель Чертежник - Справка');
(GraphABCControl as Control).Focus;
end;
@ -679,7 +692,7 @@ begin
BottomPanel.Controls.Add(groupBoxExState);
BottomPanel.Dock := DockStyle.Bottom;
BottomPanel.Location := new Point(0, 407);
BottomPanel.Size := new Size(679, 83);
BottomPanel.Size := new Size(679, 83)*ScreenScale;
//
// panelBottomLeft
//
@ -690,43 +703,49 @@ begin
panelBottomLeft.Controls.Add(buttonStart);
panelBottomLeft.Controls.Add(tableLayoutPanelBottom);
panelBottomLeft.Location := new Point(0, 0);
panelBottomLeft.Size := new Size(474, 83);
//
// buttonHelp
//
buttonHelp.FlatStyle := System.Windows.Forms.FlatStyle.System;
buttonHelp.Location := new Point(359, 18);
buttonHelp.Size := new Size(107, 24);
buttonHelp.TabStop := false;
buttonHelp.Text := 'Справка (F1)';
// buttonHelp.UseVisualStyleBackColor := true;
//
// buttonExit
//
buttonExit.FlatStyle := System.Windows.Forms.FlatStyle.System;
buttonExit.Location := new System.Drawing.Point(241, 18);
buttonExit.Size := new System.Drawing.Size(107, 24);
buttonExit.TabStop := false;
buttonExit.Text := 'Выход (Esc)';
// buttonExit.UseVisualStyleBackColor := true;
//
// buttonStep
//
buttonStep.FlatStyle := FlatStyle.System;
buttonStep.Location := new Point(123, 18);
buttonStep.Size := new Size(107, 24);
buttonStep.TabStop := false;
buttonStep.Text := 'Шаг (Space)';
// buttonStep.UseVisualStyleBackColor := true;
panelBottomLeft.Size := new Size(474, 83)*ScreenScale;
var x := 10;
var h := 116;
//
// buttonStart
//
buttonStart.FlatStyle := FlatStyle.System;
buttonStart.Location := new Point(5, 18);
buttonStart.Size := new Size(107, 24);
//buttonStart.FlatStyle := FlatStyle.System;
buttonStart.Location := new Point(x, 14)*ScreenScale;
buttonStart.Size := new Size(107, 24)*ScreenScale;
buttonStart.TabStop := false;
buttonStart.Text := 'Пуск (Enter)';
// buttonStart.UseVisualStyleBackColor := true;
x += h;
//
// buttonStep
//
//buttonStep.FlatStyle := FlatStyle.System;
buttonStep.Location := new Point(x, 14)*ScreenScale;
buttonStep.Size := new Size(107, 24)*ScreenScale;
buttonStep.TabStop := false;
buttonStep.Text := 'Шаг (Space)';
// buttonStep.UseVisualStyleBackColor := true;
x += h;
//
// buttonExit
//
//buttonExit.FlatStyle := System.Windows.Forms.FlatStyle.System;
buttonExit.Location := new System.Drawing.Point(x, 14)*ScreenScale;
buttonExit.Size := new System.Drawing.Size(107, 24)*ScreenScale;
buttonExit.TabStop := false;
buttonExit.Text := 'Выход (Esc)';
// buttonExit.UseVisualStyleBackColor := true;
x += h;
//
// buttonHelp
//
//buttonHelp.FlatStyle := System.Windows.Forms.FlatStyle.System;
buttonHelp.Location := new Point(x, 14)*ScreenScale;
buttonHelp.Size := new Size(107, 24)*ScreenScale;
buttonHelp.TabStop := false;
buttonHelp.Text := 'Справка (F1)';
// buttonHelp.UseVisualStyleBackColor := true;
//
// tableLayoutPanelBottom
//
@ -736,21 +755,22 @@ begin
tableLayoutPanelBottom.ColumnStyles.Add(new ColumnStyle(SizeType.Percent, 50));
tableLayoutPanelBottom.Controls.Add(labelExState);
tableLayoutPanelBottom.ForeColor := System.Drawing.Color.White;
tableLayoutPanelBottom.Location := new Point(4, 52);
tableLayoutPanelBottom.Location := new Point(9, 49)*ScreenScale;
tableLayoutPanelBottom.RowCount := 1;
tableLayoutPanelBottom.RowStyles.Add(new RowStyle(SizeType.Percent, 50));
tableLayoutPanelBottom.Size := new Size(463, 23);
tableLayoutPanelBottom.Size := new Size(457, 23)*ScreenScale;
//tableLayoutPanelBottom.AutoSize := True;
//
// labelExState
//
labelExState.AutoEllipsis := true;
labelExState.AutoSize := true;
labelExState.Dock := DockStyle.Fill;
labelExState.FlatStyle := FlatStyle.System;
labelExState.Font := new System.Drawing.Font('Microsoft Sans Serif', 8, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, ((byte)(204)));
//labelExState.FlatStyle := FlatStyle.System;
labelExState.Font := new System.Drawing.Font('Microsoft Sans Serif', 8, System.Drawing.FontStyle.Bold{, System.Drawing.GraphicsUnit.Point, ((byte)(204))});
labelExState.Location := new Point(5, 2);
labelExState.Margin := new Padding(3, 0, 3, 3);
labelExState.Size := new Size(453, 15);
labelExState.Margin := new Padding(3, 3, 3, 3);
labelExState.Size := new Size(453, 15)*ScreenScale;
labelExState.Text := 'Чертежник: Готов';
labelExState.TextAlign := ContentAlignment.MiddleCenter;
//
@ -762,8 +782,8 @@ begin
groupBoxExState.Controls.Add(trackBarSpeed);
groupBoxExState.Controls.Add(labelSpeed);
groupBoxExState.Dock := DockStyle.Right;
groupBoxExState.Location := new Point(475, 0);
groupBoxExState.Size := new Size(204, 83);
groupBoxExState.Location := new Point(475, 0)*ScreenScale;
groupBoxExState.Size := new Size(204, 83)*ScreenScale;
groupBoxExState.TabStop := false;
//
// tableLayoutPanel1
@ -772,43 +792,43 @@ begin
tableLayoutPanel1.CellBorderStyle := TableLayoutPanelCellBorderStyle.Outset;
tableLayoutPanel1.ColumnCount := 1;
tableLayoutPanel1.ColumnStyles.Add(new ColumnStyle(System.Windows.Forms.SizeType.Percent, 50));
tableLayoutPanel1.Location := new Point(91, 52);
tableLayoutPanel1.Location := new Point(78, 50)*ScreenScale;
tableLayoutPanel1.RowCount := 1;
tableLayoutPanel1.RowStyles.Add(new RowStyle(System.Windows.Forms.SizeType.Percent, 50));
tableLayoutPanel1.Size := new Size(22, 22);
tableLayoutPanel1.Size := new Size(22, 22)*ScreenScale;
//
// labelState
//
labelState.AutoSize := true;
labelState.Location := new Point(6, 54);
labelState.Location := new Point(6, 54)*ScreenScale;
labelState.Margin := new Padding(0);
labelState.Size := new Size(83, 17);
labelState.Size := new Size(83, 17)*ScreenScale;
labelState.Text := 'Состояние:';
//
// labelStep
//
labelStep.BackColor := SystemColors.Control;
labelStep.Font := new System.Drawing.Font('Microsoft Sans Serif', 8, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, ((byte)(204)));
//labelStep.Font := new System.Drawing.Font('Microsoft Sans Serif', 8, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, ((byte)(204)));
labelStep.ForeColor := System.Drawing.Color.Black;
labelStep.Location := new Point(130, 54);
labelStep.Size := new Size(66, 18);
labelStep.Location := new Point(130, 54)*ScreenScale;
labelStep.Size := new Size(66, 18)*ScreenScale;
labelStep.Text := 'Шаг: 0';
labelStep.TextAlign := ContentAlignment.MiddleLeft;
//labelStep.TextAlign := ContentAlignment.MiddleLeft;
//
// trackBarSpeed
//
trackBarSpeed.CausesValidation := false;
trackBarSpeed.LargeChange := 1;
trackBarSpeed.Location := new Point(80, 11);
trackBarSpeed.Size := new Size(121, 53);
trackBarSpeed.Location := new Point(72, 11)*ScreenScale;
trackBarSpeed.Size := new Size(121, 53)*ScreenScale;
trackBarSpeed.TabStop := false;
//
// labelSpeed
//
labelSpeed.AutoSize := true;
labelSpeed.Location := new Point(6, 16);
labelSpeed.Location := new Point(6, 16)*ScreenScale;
labelSpeed.Margin := new Padding(0);
labelSpeed.Size := new Size(73, 17);
labelSpeed.Size := new Size(73, 17)*ScreenScale;
labelSpeed.Text := 'Скорость:';
//
// tableLayoutPanelTop
@ -822,29 +842,37 @@ begin
tableLayoutPanelTop.Location := new Point(0, 0);
tableLayoutPanelTop.RowCount := 1;
tableLayoutPanelTop.RowStyles.Add(new RowStyle(System.Windows.Forms.SizeType.Percent, 50));
tableLayoutPanelTop.Size := new Size(679, 23);
tableLayoutPanelTop.AutoSize := True;
tableLayoutPanelTop.Size := new Size(679, 23)*ScreenScale;
//
// labelZad
//
labelZad.AutoEllipsis := true;
labelZad.AutoSize := true;
//labelZad.AutoSize := true;
labelZad.Dock := DockStyle.Fill;
labelZad.FlatStyle := FlatStyle.System;
labelZad.Font := new System.Drawing.Font('Microsoft Sans Serif', 8, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, ((byte)(204)));
//labelZad.FlatStyle := FlatStyle.System;
labelZad.Font := new System.Drawing.Font('Microsoft Sans Serif', 8, System.Drawing.FontStyle.Bold{, System.Drawing.GraphicsUnit.Point, ((byte)(204))});
labelZad.ForeColor := SystemColors.HotTrack;
labelZad.Location := new Point(6, 3);
labelZad.Margin := new Padding(4, 1, 3, 0);
labelZad.Size := new Size(668, 14);
labelZad.Size := new Size(668, 14)*ScreenScale;
labelZad.Text := 'Задание';
labelZad.TextAlign := ContentAlignment.MiddleLeft;
//
// ExecutorForm
//
MainForm.BackColor := SystemColors.Control;
// MainForm.ClientSize := new Size(679, 490);
// MainWindow.ClientSize := new Size(679, 490);
MainForm.Controls.Add(tableLayoutPanelTop);
MainForm.Controls.Add(BottomPanel);
MainForm.MinimumSize := new Size(687, 240);
var ssz := 692;
var sw := ScreenSize.Width;
var ww := ssz*ScreenScale;
if ww>sw then
ssz := Round(sw/ScreenScale) - 10;
MainForm.MinimumSize := new Size(ssz, 240)*ScreenScale; // Уменьшить до размера экрана!!!
MainForm.Text := 'Исполнитель Чертежник';
BottomPanel.ResumeLayout(false);
panelBottomLeft.ResumeLayout(false);
@ -969,7 +997,8 @@ begin
//MainForm.Bounds := new System.Drawing.Rectangle(settings.Left,settings.Top,settings.Width,settings.Height);
SetSmoothingOff;
//GraphABCControl.BackColor := MainForm.BackColor;
MainForm.Invoke(MainForm.Show);
var del : procedure := MainForm.Show;
MainForm.Invoke(del);
end;
procedure __InitModule__;

36
TestSuite/formatter_tests/input/Drawman.pas
View file

@ -1,3 +1,6 @@
// Copyright (c) Ivan Bondarev, Stanislav Mikhalkovich (for details please see \doc\copyright.txt)
// This code is distributed under the GNU LGPL (for details please see \doc\license.txt)
///Исполнитель Чертежник предназначен для построения рисунков и чертежей на плоскости с координатами.
///Чертежник имеет перо, которое он может поднимать, опускать и перемещать. При перемещении опущенного пера за ним остается след.
unit Drawman;
@ -26,6 +29,25 @@ procedure Start;
/// Остановить Чертежника
procedure Stop;
/// Поднять перо
procedure ОпуститьПеро;
/// Опустить перо
procedure ПоднятьПеро;
/// Переместиться к точке (x,y)
procedure КТочке(x,y: integer);
/// Переместиться на вектор (a,b)
procedure НаВектор(a,b: integer);
/// Вызывать задание с данным именем
procedure Задание(имя: string);
/// Создать пустое поле размера 9 на 11 клеток
procedure СтандартноеПоле;
/// Создать пустое поле размера n на m клеток
procedure Поле(n,m: integer);
/// Установить ширину пера Чертежника
procedure SetDrawmanWidth(w: integer);
///--
procedure __InitModule__;
///--
@ -35,6 +57,11 @@ implementation
uses DMTaskMaker,DMZadan,DrawmanField;
procedure SetDrawmanWidth(w: integer);
begin
DMField.dmwidth := w
end;
procedure Start;
begin
DMField.Start;
@ -102,6 +129,15 @@ begin
Stop;
end;
procedure ОпуститьПеро := PenDown;
procedure ПоднятьПеро := PenUp;
procedure КТочке(x,y: integer) := ToPoint(x,y);
procedure НаВектор(a,b: integer) := OnVector(a,b);
procedure Задание(имя: string) := Task(имя);
procedure СтандартноеПоле := StandardField;
procedure Поле(n,m: integer) := Field(n,m);
procedure RegisterTasks;
begin
RegisterTask('a1',a1);

41
TestSuite/formatter_tests/input/FormsABC.pas
View file

@ -1,3 +1,5 @@
// Copyright (c) Ivan Bondarev, Stanislav Mikhalkovich (for details please see \doc\copyright.txt)
// This code is distributed under the GNU LGPL (for details please see \doc\license.txt)
unit FormsABC;
{$apptype windows}
@ -68,20 +70,35 @@ type
/// Кнопка
Button = class
private
protected
b := new System.Windows.Forms.Button;
procedure BClick(sender: Object; e: EventArgs);
function GetW := b.Width;
procedure SetW(w: integer) := b.Width := w;
function GetText := b.Text;
procedure SetText(t: string) := b.Text := t;
public
event Click: procedure;
constructor Create(text: string);
constructor Create(text: string := '');
property Width: integer read GetW write SetW;
property Text: string read GetText write SetText;
end;
/// Текстовая метка
TextLabel = class
private
protected
l := new System.Windows.Forms.Label;
function GetT(): string;
begin
Result := l.Text
end;
procedure SetT(w: string);
begin
l.Text := w;
end;
public
constructor(text: string);
property Text: string read GetT write SetT;
end;
/// Флажок
@ -108,7 +125,7 @@ type
/// Список
ListBox = class
private
protected
lb := new System.Windows.Forms.ListBox;
function GetItems: System.Windows.Forms.ListBox.ObjectCollection;
function GetSelectedIndex: integer;
@ -121,7 +138,7 @@ type
public
event Click: procedure;
event SelectedIndexChanged: procedure;
constructor;
constructor Create;
property Items: System.Windows.Forms.ListBox.ObjectCollection read GetItems;
property SelectedIndex: integer read GetSelectedIndex write SetSelectedIndex;
property SelectedItem: object read GetSelectedItem write SetSelectedItem;
@ -238,6 +255,11 @@ type
private
function GetText: string;
procedure SetText(s: string);
function GetDocumentStream: System.IO.Stream := (f as System.Windows.Forms.WebBrowser).DocumentStream;
procedure SetDocumentStream(s: System.IO.Stream);
begin
(f as System.Windows.Forms.WebBrowser).DocumentStream := s;
end;
function GetAddress: string;
procedure WBDocumentCompleted(sender: Object; e: WebBrowserDocumentCompletedEventArgs);
public
@ -249,6 +271,7 @@ type
procedure GoForward;
procedure GoHome;
property Address: string read GetAddress;
property DocumentStream: System.IO.Stream read GetDocumentStream write SetDocumentStream;
end;
/// Окно для рисования
@ -465,6 +488,11 @@ var
// Эксперимент: 20.11.10
ParentControl: ContainerControl;
///--
procedure __InitModule__;
///--
procedure __FinalizeModule__;
implementation
var
@ -709,7 +737,7 @@ end;
constructor ListBox.Create;
begin
lb.AutoSize := True;
//lb.AutoSize := True;
ParentControl.Add(lb);
CurrentControl := lb;
lb.Click += LBClick;
@ -991,6 +1019,7 @@ end;
constructor WebBrowser.Create();
begin
f := new System.Windows.Forms.WebBrowser;
(f as System.Windows.Forms.WebBrowser).ScriptErrorsSuppressed := True;
ParentControl.Add(f);
CurrentControl := f;
(f as System.Windows.Forms.WebBrowser).DocumentCompleted += WBDocumentCompleted;

2092
TestSuite/formatter_tests/input/GraphABC.pas
View file

File diff suppressed because it is too large Load diff

1163
TestSuite/formatter_tests/input/GraphWPF.pas
View file

File diff suppressed because it is too large Load diff

114
TestSuite/formatter_tests/input/GraphWPFBase.pas
View file

@ -1,4 +1,4 @@
// Copyright (c) Ivan Bondarev, Stanislav Mihalkovich (for details please see \doc\copyright.txt)
// Copyright (c) Ivan Bondarev, Stanislav Mikhalkovich (for details please see \doc\copyright.txt)
// This code is distributed under the GNU LGPL (for details please see \doc\license.txt)
///--
unit GraphWPFBase;
@ -11,12 +11,14 @@ unit GraphWPFBase;
uses System.Windows;
uses System.Windows.Controls;
uses System.Windows.Media;
type
/// Тип цвета
GColor = System.Windows.Media.Color;
/// Тип прямоугольника
GRect = System.Windows.Rect;
GBrush = System.Windows.Media.Brush;
GWindow = System.Windows.Window;
GMainWindow = class(GWindow)
@ -27,7 +29,6 @@ type
g.LastChildFill := True;
Result := g;
end;
procedure InitMainGraphControl; virtual;
begin
end;
@ -57,6 +58,19 @@ var
app: Application;
MainWindow: GMainWindow;
var BrushesDict := new Dictionary<GColor,GBrush>;
function GetBrush(c: GColor): GBrush;
begin
if not (c in BrushesDict) then
begin
var b := new SolidColorBrush(c);
BrushesDict[c] := b;
Result := b
end
else Result := BrushesDict[c];
end;
procedure Invoke(d: System.Delegate; params args: array of object) := app.Dispatcher.Invoke(d, args);
procedure InvokeP(p: procedure(r: real); r: real) := Invoke(p,r);
@ -90,6 +104,8 @@ type
function GetHeight: real;
procedure SetCaption(c: string);
function GetCaption: string;
procedure SetFixedSize(b: boolean);
function GetFixedSize: boolean;
public
/// Отступ главного окна от левого края экрана
property Left: real read GetLeft write SetLeft;
@ -103,10 +119,12 @@ type
property Caption: string read GetCaption write SetCaption;
/// Заголовок окна
property Title: string read GetCaption write SetCaption;
/// Имеет ли графическое окно фиксированный размер
property IsFixedSize: boolean read GetFixedSize write SetFixedSize;
/// Очищает графическое окно белым цветом
procedure Clear; virtual;
/// Очищает графическое окно цветом c
procedure Clear(c: GColor);
/// Очищает графическое окно указанным цветом
procedure Clear(c: GColor); virtual;
/// Устанавливает размеры клиентской части главного окна
procedure SetSize(w, h: real);
/// Устанавливает отступ главного окна от левого верхнего края экрана
@ -125,12 +143,29 @@ type
function Center: Point;
/// Возвращает прямоугольник клиентской области окна
function ClientRect: GRect;
/// Возвращает случайную точку в границах экрана. Необязательный параметр w задаёт минимальный отступ от границы
function RandomPoint(w: real := 0): Point;
private procedure CenterOnScreenP;
end;
//{{{--doc: Конец секции 1 }}}
function wplus := SystemParameters.WindowResizeBorderThickness.Left + SystemParameters.WindowResizeBorderThickness.Right;
function hplus := SystemParameters.WindowCaptionHeight + SystemParameters.WindowResizeBorderThickness.Top + SystemParameters.WindowResizeBorderThickness.Bottom;
var wp: real := -1;
var hp: real := -1;
function wplus: real;
begin
if wp = -1 then
wp := (SystemParameters.BorderWidth + SystemParameters.FixedFrameVerticalBorderWidth) * 2;
Result := wp;
end;
function hplus: real;
begin
if hp = -1 then
hp := SystemParameters.WindowCaptionHeight + (SystemParameters.BorderWidth + SystemParameters.FixedFrameHorizontalBorderHeight) * 2;
Result := hp;
end;
///---- Window -----
@ -146,16 +181,38 @@ procedure WindowType.SetTop(t: real) := Invoke(WindowTypeSetTopP,t);
function WindowTypeGetTopP := MainWindow.Top;
function WindowType.GetTop := InvokeReal(WindowTypeGetTopP);
procedure WindowTypeSetWidthP(w: real) := MainWindow.Width := w + wplus;
procedure WindowTypeSetWidthP(w: real);
begin
if MainWindow.ResizeMode = ResizeMode.NoResize then
MainWindow.Width := w + 2.5
else MainWindow.Width := w + wplus;
end;
procedure WindowType.SetWidth(w: real) := Invoke(WindowTypeSetWidthP,w);
function WindowTypeGetWidthP := MainWindow.ActualWidth - wplus;
function WindowTypeGetWidthP: real;
begin
if MainWindow.ResizeMode = ResizeMode.NoResize then
Result := MainWindow.ActualWidth - 2.5
else Result := MainWindow.ActualWidth - wplus;
end;
function WindowType.GetWidth := InvokeReal(WindowTypeGetWidthP);
procedure WindowTypeSetHeightP(h: real) := MainWindow.Height := h + hplus;
procedure WindowTypeSetHeightP(h: real);
begin
if MainWindow.ResizeMode = ResizeMode.NoResize then
MainWindow.Height := h + SystemParameters.WindowCaptionHeight + 2.5
else MainWindow.Height := h + hplus;
end;
procedure WindowType.SetHeight(h: real) := Invoke(WindowTypeSetHeightP,h);
function WindowTypeGetHeightP := MainWindow.ActualHeight - hplus;
function WindowTypeGetHeightP: real;
begin
if MainWindow.ResizeMode = ResizeMode.NoResize then
Result := MainWindow.ActualHeight - SystemParameters.WindowCaptionHeight - 2.5
else Result := MainWindow.ActualHeight - hplus;
//Print(SystemParameters.WindowCaptionHeight, SystemParameters.WindowResizeBorderThickness.Top, SystemParameters.WindowResizeBorderThickness.Bottom);
end;
function WindowType.GetHeight := InvokeReal(WindowTypeGetHeightP);
procedure WindowTypeSetCaptionP(c: string) := MainWindow.Title := c;
@ -164,6 +221,17 @@ procedure WindowType.SetCaption(c: string) := Invoke(WindowTypeSetCaptionP,c);
function WindowTypeGetCaptionP := MainWindow.Title;
function WindowType.GetCaption := Invoke&<string>(WindowTypeGetCaptionP);
procedure WindowTypeSetFixedSizeP(b: boolean);
begin
if b then
MainWindow.ResizeMode := ResizeMode.NoResize
else MainWindow.ResizeMode := ResizeMode.CanResize;
end;
procedure WindowType.SetFixedSize(b: boolean) := Invoke(WindowTypeSetFixedSizeP,b);
function WindowTypeGetFixedSizeP := MainWindow.ResizeMode = ResizeMode.NoResize;
function WindowType.GetFixedSize := Invoke&<boolean>(WindowTypeGetFixedSizeP);
procedure WindowTypeClearP := begin {Host.children.Clear; CountVisuals := 0;} end;
procedure WindowType.Clear := Invoke(WindowTypeClearP);
@ -197,8 +265,14 @@ procedure WindowType.Maximize := Invoke(WindowTypeMaximizeP);
procedure WindowTypeNormalizeP := MainWindow.WindowState := WindowState.Normal;
procedure WindowType.Normalize := Invoke(WindowTypeNormalizeP);
procedure WindowTypeCenterOnScreenP := MainWindow.WindowStartupLocation := WindowStartupLocation.CenterScreen;
procedure WindowType.CenterOnScreen := Invoke(WindowTypeCenterOnScreenP);
procedure WindowType.CenterOnScreenP;
begin
var w := SystemParameters.PrimaryScreenWidth - MainWindow.Width;
var h := SystemParameters.PrimaryScreenHeight - Mainwindow.Height;
SetPos(w/2,h/2);
end;
procedure WindowType.CenterOnScreen := Invoke(CenterOnScreenP);
function Pnt(x,y: real) := new Point(x,y);
function Rect(x,y,w,h: real) := new System.Windows.Rect(x,y,w,h);
@ -207,19 +281,27 @@ function WindowType.Center := Pnt(Width/2,Height/2);
function WindowType.ClientRect := Rect(0,0,Width,Height);
function WindowType.RandomPoint(w: real): Point := Pnt(Random(w,Width-w),Random(w,Height-w));
function operator implicit(Self: (integer, integer)): Point; extensionmethod := new Point(Self[0], Self[1]);
function operator implicit(Self: (integer, real)): Point; extensionmethod := new Point(Self[0], Self[1]);
function operator implicit(Self: (real, integer)): Point; extensionmethod := new Point(Self[0], Self[1]);
function operator implicit(Self: (real, real)): Point; extensionmethod := new Point(Self[0], Self[1]);
function operator implicit(Self: (integer, integer)): Size; extensionmethod := new Size(Self[0], Self[1]);
function operator implicit(Self: (integer, real)): Size; extensionmethod := new Size(Self[0], Self[1]);
function operator implicit(Self: (real, integer)): Size; extensionmethod := new Size(Self[0], Self[1]);
function operator implicit(Self: (real, real)): Size; extensionmethod := new Size(Self[0], Self[1]);
function operator implicit(Self: array of (real, real)): array of Point; extensionmethod :=
Self.Select(t->new Point(t[0],t[1])).ToArray;
function operator implicit(Self: array of (integer, integer)): array of Point; extensionmethod :=
Self.Select(t->new Point(t[0],t[1])).ToArray;
procedure SetLeft(Self: UIElement; l: integer); extensionmethod := Canvas.SetLeft(Self,l);
procedure SetLeft(Self: UIElement; l: real); extensionmethod := Canvas.SetLeft(Self,l);
procedure SetTop(Self: UIElement; t: integer); extensionmethod := Canvas.SetTop(Self,t);
procedure SetTop(Self: UIElement; t: real); extensionmethod := Canvas.SetTop(Self,t);
var __initialized: boolean;
@ -236,6 +318,8 @@ begin
end;
end;
begin
initialization
__InitModule;
finalization
end.

4
TestSuite/formatter_tests/input/MPI.pas
View file

@ -1,3 +1,5 @@
// Copyright (c) Ivan Bondarev, Stanislav Mikhalkovich (for details please see \doc\copyright.txt)
// This code is distributed under the GNU LGPL (for details please see \doc\license.txt)
unit MPI;
interface
@ -75,7 +77,7 @@ const
MPI_GROUP_NULL = 0;
MPI_DATATYPE_NULL = 0;
MPI_REQUEST_NULL = 0;
MPI_BOTTOM = pointer(0);
MPI_BOTTOM: pointer = nil;
MPI_ERRORS_ARE_FATAL = 119;
MPI_ERRORS_RETURN = 120;

70
TestSuite/formatter_tests/input/NUnitABC.pas Normal file
View file

@ -0,0 +1,70 @@
unit NUnitABC;
{$reference nunit.framework.dll}
uses NUnit.Framework;
procedure InitPABCSystem;
begin
__InitPABCSystem;
end;
type
CombinatorialAttribute = NUnit.Framework.CombinatorialAttribute;
PairwiseAttribute = NUnit.Framework.PairwiseAttribute;
IgnoreAttribute = NUnit.Framework.IgnoreAttribute;
OrderAttribute = NUnit.Framework.OrderAttribute;
SetUpAttribute = NUnit.Framework.SetUpAttribute;
TearDownAttribute = NUnit.Framework.TearDownAttribute;
TestAttribute = NUnit.Framework.TestAttribute;
TestCaseAttribute = NUnit.Framework.TestCaseAttribute;
TimeoutAttribute = NUnit.Framework.TimeoutAttribute;
RandomAttribute = NUnit.Framework.RandomAttribute;
RangeAttribute = NUnit.Framework.RangeAttribute;
RepeatAttribute = NUnit.Framework.RepeatAttribute;
TestFixtureAttribute = NUnit.Framework.TestFixtureAttribute;
ValuesAttribute = NUnit.Framework.ValuesAttribute;
Assert = NUnit.Framework.Assert;
Assume = NUnit.Framework.Assume;
Does = NUnit.Framework.Does;
Has = NUnit.Framework.Has;
&Is = NUnit.Framework.Is;
StringAssert = NUnit.Framework.StringAssert;
Warn = NUnit.Framework.Warn;
AllOperator = NUnit.Framework.Constraints.AllOperator;
AndOperator = NUnit.Framework.Constraints.AndOperator;
BinaryOperator = NUnit.Framework.Constraints.BinaryOperator;
CollectionOperator = NUnit.Framework.Constraints.CollectionOperator;
Interval = NUnit.Framework.Constraints.Interval;
OrOperator = NUnit.Framework.Constraints.OrOperator;
WithOperator = NUnit.Framework.Constraints.WithOperator;
Tolerance = NUnit.Framework.Constraints.Tolerance;
Constraint = NUnit.Framework.Constraints.Constraint;
AndConstraint = NUnit.Framework.Constraints.AndConstraint;
AnyOfConstraint = NUnit.Framework.Constraints.AnyOfConstraint;
BinaryConstraint = NUnit.Framework.Constraints.BinaryConstraint;
CollectionConstraint = NUnit.Framework.Constraints.CollectionConstraint;
EndsWithConstraint = NUnit.Framework.Constraints.EndsWithConstraint;
EqualConstraint = NUnit.Framework.Constraints.EqualConstraint;
FalseConstraint = NUnit.Framework.Constraints.FalseConstraint;
GreaterThanConstraint = NUnit.Framework.Constraints.GreaterThanConstraint;
GreaterThanOrEqualConstraint = NUnit.Framework.Constraints.GreaterThanOrEqualConstraint;
LessThanConstraint = NUnit.Framework.Constraints.LessThanConstraint;
LessThanOrEqualConstraint = NUnit.Framework.Constraints.LessThanOrEqualConstraint;
NotConstraint = NUnit.Framework.Constraints.NotConstraint;
OrConstraint = NUnit.Framework.Constraints.OrConstraint;
RangeConstraint = NUnit.Framework.Constraints.RangeConstraint;
StartsWithConstraint = NUnit.Framework.Constraints.StartsWithConstraint;
StringConstraint = NUnit.Framework.Constraints.StringConstraint;
SubStringConstraint = NUnit.Framework.Constraints.SubStringConstraint;
TrueConstraint = NUnit.Framework.Constraints.TrueConstraint;
AssertionException = NUnit.Framework.AssertionException;
begin
end.

13524
TestSuite/formatter_tests/input/OpenCL.pas Normal file
View file

File diff suppressed because it is too large Load diff

565
TestSuite/formatter_tests/input/OpenCLABC.pas Normal file
View file

@ -0,0 +1,565 @@

//*****************************************************************************************************\\
// Copyright (©) Cergey Latchenko ( github.com/SunSerega | forum.mmcs.sfedu.ru/u/sun_serega )
// This code is distributed under the Unlicense
// For details see LICENSE file or this:
// https://github.com/SunSerega/POCGL/blob/master/LICENSE
//*****************************************************************************************************\\
// Copyright (©) Сергей Латченко ( github.com/SunSerega | forum.mmcs.sfedu.ru/u/sun_serega )
// Этот код распространяется с лицензией Unlicense
// Подробнее в файле LICENSE или тут:
// https://github.com/SunSerega/POCGL/blob/master/LICENSE
//*****************************************************************************************************\\
///
///Высокоуровневая оболочка модуля OpenCL
/// OpenCL и OpenCLABC можно использовать одновременно
/// Но контактировать они практически не будут
///
///Если не хватает типа/метода или найдена ошибка - писать сюда:
/// https://github.com/SunSerega/POCGL/issues
///
///Справка данного модуля находится в папке примеров
/// По-умолчанию, её можно найти в "C:\PABCWork.NET\Samples\OpenGL и OpenCL"
///
unit OpenCLABC;
interface
uses System;
uses OpenCL;
uses OpenCLABCBase;
{$region Re:definition's}
type
///Тип устройства, поддерживающего OpenCL
DeviceType = OpenCL.DeviceType;
///Уровень кэша, используемый в Device.SplitByAffinityDomain
DeviceAffinityDomain = OpenCL.DeviceAffinityDomain;
///Представляет платформу OpenCL, объединяющую одно или несколько устройств
Platform = OpenCLABCBase.Platform;
///Представляет устройство, поддерживающее OpenCL
Device = OpenCLABCBase.Device;
///Представляет виртуальное устройство, использующее часть ядер другого устройства
///Объекты данного типа обычно создаются методами "Device.Split*"
SubDevice = OpenCLABCBase.SubDevice;
///Представляет контекст для хранения данных и выполнения команд на GPU
Context = OpenCLABCBase.Context;
///Представляет область памяти устройства OpenCL
Buffer = OpenCLABCBase.Buffer;
///Представляет область памяти внутри другого буфера
SubBuffer = OpenCLABCBase.SubBuffer;
///Представляет подпрограмму, выполняемую на GPU
Kernel = OpenCLABCBase.Kernel;
///Представляет контейнер с откомпилированным кодом для GPU, содержащим подпрограммы-kernel'ы
ProgramCode = OpenCLABCBase.ProgramCode;
///Представляет задачу выполнения очереди, создаваемую методом Context.BeginInvoke
CLTaskBase = OpenCLABCBase.CLTaskBase;
///Представляет задачу выполнения очереди, создаваемую методом Context.BeginInvoke
CLTask<T> = OpenCLABCBase.CLTask<T>;
///Представляет очередь, состоящую в основном из команд, выполняемых на GPU
CommandQueueBase = OpenCLABCBase.CommandQueueBase;
///Представляет очередь, состоящую в основном из команд, выполняемых на GPU
CommandQueue<T> = OpenCLABCBase.CommandQueue<T>;
///Интерфейс, который реализован только классом ConstQueue<T>
///Позволяет получить значение, из которого была создана константая очередь, не зная его типа
IConstQueue = OpenCLABCBase.IConstQueue;
///Представляет константную очередь
///Константные очереди ничего не выполняют и возвращает заданное при создании значение
ConstQueue<T> = OpenCLABCBase.ConstQueue<T>;
///Представляет очередь-контейнер для команд GPU, применяемых к объекту типа Buffer
BufferCommandQueue = OpenCLABCBase.BufferCommandQueue;
///Представляет очередь-контейнер для команд GPU, применяемых к объекту типа Kernel
KernelCommandQueue = OpenCLABCBase.KernelCommandQueue;
///Представляет аргумент, передаваемый в вызов kernel-а
KernelArg = OpenCLABCBase.KernelArg;
{$endregion Re:definition's}
{$region HFQ/HPQ}
///Создаёт очередь, выполняющую указанную функцию на CPU
///И возвращающую результат этой функци
function HFQ<T>(f: ()->T): CommandQueue<T>;
///Создаёт очередь, выполняющую указанную функцию на CPU
///И возвращающую результат этой функци
function HFQ<T>(f: Context->T): CommandQueue<T>;
///Создаёт очередь, выполняющую указанную процедуру на CPU
///И возвращающую object(nil)
function HPQ(p: ()->()): CommandQueueBase;
///Создаёт очередь, выполняющую указанную процедуру на CPU
///И возвращающую object(nil)
function HPQ(p: Context->()): CommandQueueBase;
{$endregion HFQ/HPQ}
{$region WaitFor}
///Создаёт очередь, ожидающую сигнала выполненности от каждой из указанных очередей
function WaitForAll(params qs: array of CommandQueueBase): CommandQueueBase;
///Создаёт очередь, ожидающую сигнала выполненности от каждой из указанных очередей
function WaitForAll(qs: sequence of CommandQueueBase): CommandQueueBase;
///Создаёт очередь, ожидающую первого сигнала выполненности от любой из указанных очередей
function WaitForAny(params qs: array of CommandQueueBase): CommandQueueBase;
///Создаёт очередь, ожидающую первого сигнала выполненности от любой из указанных очередей
function WaitForAny(qs: sequence of CommandQueueBase): CommandQueueBase;
///Создаёт очередь, ожидающую сигнала выполненности от указанной очереди
function WaitFor(q: CommandQueueBase): CommandQueueBase;
{$endregion WaitFor}
{$region CombineQueue's}
{$region Sync}
{$region NonConv}
///Создаёт очередь, выполняющую указанные очереди одну за другой
///И возвращающую результат последней очереди
function CombineSyncQueueBase(params qs: array of CommandQueueBase): CommandQueueBase;
///Создаёт очередь, выполняющую указанные очереди одну за другой
///И возвращающую результат последней очереди
function CombineSyncQueueBase(qs: sequence of CommandQueueBase): CommandQueueBase;
///Создаёт очередь, выполняющую указанные очереди одну за другой
///И возвращающую результат последней очереди
function CombineSyncQueue<T>(qs: sequence of CommandQueueBase; last: CommandQueue<T>): CommandQueue<T>;
///Создаёт очередь, выполняющую указанные очереди одну за другой
///И возвращающую результат последней очереди
function CombineSyncQueue<T>(params qs: array of CommandQueue<T>): CommandQueue<T>;
///Создаёт очередь, выполняющую указанные очереди одну за другой
///И возвращающую результат последней очереди
function CombineSyncQueue<T>(qs: sequence of CommandQueue<T>): CommandQueue<T>;
{$endregion NonConv}
{$region Conv}
{$region NonContext}
///Создаёт очередь, выполняющую указанные очереди одну за другой
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineSyncQueue<TRes>(conv: Func<array of object, TRes>; params qs: array of CommandQueueBase): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одну за другой
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineSyncQueue<TRes>(conv: Func<array of object, TRes>; qs: sequence of CommandQueueBase): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одну за другой
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineSyncQueue<TInp, TRes>(conv: Func<array of TInp, TRes>; params qs: array of CommandQueue<TInp>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одну за другой
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineSyncQueue<TInp, TRes>(conv: Func<array of TInp, TRes>; qs: sequence of CommandQueue<TInp>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одну за другой
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineSyncQueue2<TInp1, TInp2, TRes>(conv: Func<TInp1, TInp2, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одну за другой
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineSyncQueue3<TInp1, TInp2, TInp3, TRes>(conv: Func<TInp1, TInp2, TInp3, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одну за другой
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineSyncQueue4<TInp1, TInp2, TInp3, TInp4, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одну за другой
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineSyncQueue5<TInp1, TInp2, TInp3, TInp4, TInp5, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TInp5, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>; q5: CommandQueue<TInp5>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одну за другой
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineSyncQueue6<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>; q5: CommandQueue<TInp5>; q6: CommandQueue<TInp6>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одну за другой
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineSyncQueue7<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TInp7, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TInp7, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>; q5: CommandQueue<TInp5>; q6: CommandQueue<TInp6>; q7: CommandQueue<TInp7>): CommandQueue<TRes>;
{$endregion NonContext}
{$region Context}
///Создаёт очередь, выполняющую указанные очереди одну за другой
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineSyncQueue<TRes>(conv: Func<array of object, Context, TRes>; params qs: array of CommandQueueBase): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одну за другой
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineSyncQueue<TRes>(conv: Func<array of object, Context, TRes>; qs: sequence of CommandQueueBase): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одну за другой
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineSyncQueue<TInp, TRes>(conv: Func<array of TInp, Context, TRes>; params qs: array of CommandQueue<TInp>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одну за другой
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineSyncQueue<TInp, TRes>(conv: Func<array of TInp, Context, TRes>; qs: sequence of CommandQueue<TInp>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одну за другой
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineSyncQueue2<TInp1, TInp2, TRes>(conv: Func<TInp1, TInp2, Context, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одну за другой
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineSyncQueue3<TInp1, TInp2, TInp3, TRes>(conv: Func<TInp1, TInp2, TInp3, Context, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одну за другой
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineSyncQueue4<TInp1, TInp2, TInp3, TInp4, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, Context, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одну за другой
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineSyncQueue5<TInp1, TInp2, TInp3, TInp4, TInp5, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TInp5, Context, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>; q5: CommandQueue<TInp5>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одну за другой
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineSyncQueue6<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, Context, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>; q5: CommandQueue<TInp5>; q6: CommandQueue<TInp6>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одну за другой
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineSyncQueue7<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TInp7, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TInp7, Context, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>; q5: CommandQueue<TInp5>; q6: CommandQueue<TInp6>; q7: CommandQueue<TInp7>): CommandQueue<TRes>;
{$endregion Context}
{$endregion Conv}
{$endregion Sync}
{$region Async}
{$region NonConv}
///Создаёт очередь, выполняющую указанные очереди одновременно
///И возвращающую результат последней очереди
function CombineAsyncQueueBase(params qs: array of CommandQueueBase): CommandQueueBase;
///Создаёт очередь, выполняющую указанные очереди одновременно
///И возвращающую результат последней очереди
function CombineAsyncQueueBase(qs: sequence of CommandQueueBase): CommandQueueBase;
///Создаёт очередь, выполняющую указанные очереди одновременно
///И возвращающую результат последней очереди
function CombineAsyncQueue<T>(qs: sequence of CommandQueueBase; last: CommandQueue<T>): CommandQueue<T>;
///Создаёт очередь, выполняющую указанные очереди одновременно
///И возвращающую результат последней очереди
function CombineAsyncQueue<T>(params qs: array of CommandQueue<T>): CommandQueue<T>;
///Создаёт очередь, выполняющую указанные очереди одновременно
///И возвращающую результат последней очереди
function CombineAsyncQueue<T>(qs: sequence of CommandQueue<T>): CommandQueue<T>;
{$endregion NonConv}
{$region Conv}
{$region NonContext}
///Создаёт очередь, выполняющую указанные очереди одновременно
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineAsyncQueue<TRes>(conv: Func<array of object, TRes>; params qs: array of CommandQueueBase): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одновременно
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineAsyncQueue<TRes>(conv: Func<array of object, TRes>; qs: sequence of CommandQueueBase): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одновременно
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineAsyncQueue<TInp, TRes>(conv: Func<array of TInp, TRes>; params qs: array of CommandQueue<TInp>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одновременно
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineAsyncQueue<TInp, TRes>(conv: Func<array of TInp, TRes>; qs: sequence of CommandQueue<TInp>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одновременно
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineAsyncQueue2<TInp1, TInp2, TRes>(conv: Func<TInp1, TInp2, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одновременно
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineAsyncQueue3<TInp1, TInp2, TInp3, TRes>(conv: Func<TInp1, TInp2, TInp3, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одновременно
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineAsyncQueue4<TInp1, TInp2, TInp3, TInp4, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одновременно
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineAsyncQueue5<TInp1, TInp2, TInp3, TInp4, TInp5, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TInp5, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>; q5: CommandQueue<TInp5>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одновременно
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineAsyncQueue6<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>; q5: CommandQueue<TInp5>; q6: CommandQueue<TInp6>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одновременно
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineAsyncQueue7<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TInp7, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TInp7, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>; q5: CommandQueue<TInp5>; q6: CommandQueue<TInp6>; q7: CommandQueue<TInp7>): CommandQueue<TRes>;
{$endregion NonContext}
{$region Context}
///Создаёт очередь, выполняющую указанные очереди одновременно
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineAsyncQueue<TRes>(conv: Func<array of object, Context, TRes>; params qs: array of CommandQueueBase): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одновременно
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineAsyncQueue<TRes>(conv: Func<array of object, Context, TRes>; qs: sequence of CommandQueueBase): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одновременно
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineAsyncQueue<TInp, TRes>(conv: Func<array of TInp, Context, TRes>; params qs: array of CommandQueue<TInp>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одновременно
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineAsyncQueue<TInp, TRes>(conv: Func<array of TInp, Context, TRes>; qs: sequence of CommandQueue<TInp>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одновременно
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineAsyncQueue2<TInp1, TInp2, TRes>(conv: Func<TInp1, TInp2, Context, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одновременно
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineAsyncQueue3<TInp1, TInp2, TInp3, TRes>(conv: Func<TInp1, TInp2, TInp3, Context, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одновременно
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineAsyncQueue4<TInp1, TInp2, TInp3, TInp4, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, Context, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одновременно
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineAsyncQueue5<TInp1, TInp2, TInp3, TInp4, TInp5, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TInp5, Context, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>; q5: CommandQueue<TInp5>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одновременно
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineAsyncQueue6<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, Context, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>; q5: CommandQueue<TInp5>; q6: CommandQueue<TInp6>): CommandQueue<TRes>;
///Создаёт очередь, выполняющую указанные очереди одновременно
///Затем выполняющую указанную первым параметров функцию на CPU, передавая результаты всех очередей
///И возвращающую результат этой функции
function CombineAsyncQueue7<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TInp7, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TInp7, Context, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>; q5: CommandQueue<TInp5>; q6: CommandQueue<TInp6>; q7: CommandQueue<TInp7>): CommandQueue<TRes>;
{$endregion Context}
{$endregion Conv}
{$endregion Async}
{$endregion CombineQueue's}
implementation
{$region HFQ/HPQ}
type
CommandQueueHostQueueBase<T,TFunc> = abstract class(HostQueue<object,T>)
where TFunc: Delegate;
private f: TFunc;
public constructor(f: TFunc) := self.f := f;
private constructor := raise new InvalidOperationException($'Был вызван не_применимый конструктор без параметров... Обратитесь к разработчику OpenCLABC');
protected function InvokeSubQs(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; var cq: cl_command_queue; prev_ev: EventList): QueueRes<object>; override :=
new QueueResConst<Object>(nil, prev_ev ?? new EventList);
protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet<MultiusableCommandQueueHubBase>); override := exit;
end;
CommandQueueHostFunc<T> = sealed class(CommandQueueHostQueueBase<T, Context->T>)
protected function ExecFunc(o: object; c: Context): T; override := f(c);
end;
CommandQueueHostProc = sealed class(CommandQueueHostQueueBase<object, Context->()>)
protected function ExecFunc(o: object; c: Context): object; override;
begin
f(c);
Result := nil;
end;
end;
function HFQ<T>(f: ()->T) :=
new CommandQueueHostFunc<T>(c->f());
function HFQ<T>(f: Context->T) :=
new CommandQueueHostFunc<T>(f);
function HPQ(p: ()->()) :=
new CommandQueueHostProc(c->p());
function HPQ(p: Context->()) :=
new CommandQueueHostProc(p);
{$endregion HFQ/HPQ}
{$region WaitFor}
type
CommandQueueWaitFor = sealed class(CommandQueue<object>)
public waiter: WCQWaiter;
public constructor(waiter: WCQWaiter) :=
self.waiter := waiter;
protected function InvokeImpl(tsk: CLTaskBase; c: Context; main_dvc: cl_device_id; need_ptr_qr: boolean; var cq: cl_command_queue; prev_ev: EventList): QueueRes<object>; override;
begin
if need_ptr_qr then new System.InvalidOperationException;
var wait_ev := waiter.GetWaitEv(tsk, c);
Result := new QueueResConst<object>(nil, prev_ev=nil ? wait_ev : prev_ev+wait_ev);
end;
protected procedure RegisterWaitables(tsk: CLTaskBase; prev_hubs: HashSet<MultiusableCommandQueueHubBase>); override :=
waiter.RegisterWaitables(tsk);
end;
function WaitForAll(params qs: array of CommandQueueBase) := WaitForAll(qs.AsEnumerable);
function WaitForAll(qs: sequence of CommandQueueBase) := new CommandQueueWaitFor(new WCQWaiterAll(qs.ToArray));
function WaitForAny(params qs: array of CommandQueueBase) := WaitForAny(qs.AsEnumerable);
function WaitForAny(qs: sequence of CommandQueueBase) := new CommandQueueWaitFor(new WCQWaiterAny(qs.ToArray));
function WaitFor(q: CommandQueueBase) := WaitForAll(q);
{$endregion WaitFor}
{$region CombineQueue's}
{$region Sync}
{$region NonConv}
function CombineSyncQueueBase(params qs: array of CommandQueueBase) := new SimpleSyncQueueArray<object>(QueueArrayUtils.FlattenSyncQueueArray(qs));
function CombineSyncQueueBase(qs: sequence of CommandQueueBase) := new SimpleSyncQueueArray<object>(QueueArrayUtils.FlattenSyncQueueArray(qs));
function CombineSyncQueue<T>(qs: sequence of CommandQueueBase; last: CommandQueue<T>) := new SimpleSyncQueueArray<T>(QueueArrayUtils.FlattenSyncQueueArray(qs.Append(last as CommandQueueBase)));
function CombineSyncQueue<T>(params qs: array of CommandQueue<T>) := new SimpleSyncQueueArray<T>(QueueArrayUtils.FlattenSyncQueueArray(qs.Cast&<CommandQueueBase>));
function CombineSyncQueue<T>(qs: sequence of CommandQueue<T>) := new SimpleSyncQueueArray<T>(QueueArrayUtils.FlattenSyncQueueArray(qs.Cast&<CommandQueueBase>));
{$endregion NonConv}
{$region Conv}
{$region NonContext}
function CombineSyncQueue<TRes>(conv: Func<array of object, TRes>; params qs: array of CommandQueueBase) := new ConvSyncQueueArray<object, TRes>(qs.Select(q->q.Cast&<object>).ToArray, (a,c)->conv(a));
function CombineSyncQueue<TRes>(conv: Func<array of object, TRes>; qs: sequence of CommandQueueBase) := new ConvSyncQueueArray<object, TRes>(qs.Select(q->q.Cast&<object>).ToArray, (a,c)->conv(a));
function CombineSyncQueue<TInp, TRes>(conv: Func<array of TInp, TRes>; params qs: array of CommandQueue<TInp>) := new ConvSyncQueueArray<TInp, TRes>(qs.ToArray, (a,c)->conv(a));
function CombineSyncQueue<TInp, TRes>(conv: Func<array of TInp, TRes>; qs: sequence of CommandQueue<TInp>) := new ConvSyncQueueArray<TInp, TRes>(qs.ToArray, (a,c)->conv(a));
function CombineSyncQueue2<TInp1, TInp2, TRes>(conv: Func<TInp1, TInp2, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>) := new ConvSyncQueueArray2<TInp1, TInp2, TRes>(q1, q2, (o1, o2, c)->conv(o1, o2));
function CombineSyncQueue3<TInp1, TInp2, TInp3, TRes>(conv: Func<TInp1, TInp2, TInp3, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>) := new ConvSyncQueueArray3<TInp1, TInp2, TInp3, TRes>(q1, q2, q3, (o1, o2, o3, c)->conv(o1, o2, o3));
function CombineSyncQueue4<TInp1, TInp2, TInp3, TInp4, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>) := new ConvSyncQueueArray4<TInp1, TInp2, TInp3, TInp4, TRes>(q1, q2, q3, q4, (o1, o2, o3, o4, c)->conv(o1, o2, o3, o4));
function CombineSyncQueue5<TInp1, TInp2, TInp3, TInp4, TInp5, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TInp5, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>; q5: CommandQueue<TInp5>) := new ConvSyncQueueArray5<TInp1, TInp2, TInp3, TInp4, TInp5, TRes>(q1, q2, q3, q4, q5, (o1, o2, o3, o4, o5, c)->conv(o1, o2, o3, o4, o5));
function CombineSyncQueue6<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>; q5: CommandQueue<TInp5>; q6: CommandQueue<TInp6>) := new ConvSyncQueueArray6<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TRes>(q1, q2, q3, q4, q5, q6, (o1, o2, o3, o4, o5, o6, c)->conv(o1, o2, o3, o4, o5, o6));
function CombineSyncQueue7<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TInp7, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TInp7, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>; q5: CommandQueue<TInp5>; q6: CommandQueue<TInp6>; q7: CommandQueue<TInp7>) := new ConvSyncQueueArray7<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TInp7, TRes>(q1, q2, q3, q4, q5, q6, q7, (o1, o2, o3, o4, o5, o6, o7, c)->conv(o1, o2, o3, o4, o5, o6, o7));
{$endregion NonContext}
{$region Context}
function CombineSyncQueue<TRes>(conv: Func<array of object, Context, TRes>; params qs: array of CommandQueueBase) := new ConvSyncQueueArray<object, TRes>(qs.Select(q->q.Cast&<object>).ToArray, conv);
function CombineSyncQueue<TRes>(conv: Func<array of object, Context, TRes>; qs: sequence of CommandQueueBase) := new ConvSyncQueueArray<object, TRes>(qs.Select(q->q.Cast&<object>).ToArray, conv);
function CombineSyncQueue<TInp, TRes>(conv: Func<array of TInp, Context, TRes>; params qs: array of CommandQueue<TInp>) := new ConvSyncQueueArray<TInp, TRes>(qs.ToArray, conv);
function CombineSyncQueue<TInp, TRes>(conv: Func<array of TInp, Context, TRes>; qs: sequence of CommandQueue<TInp>) := new ConvSyncQueueArray<TInp, TRes>(qs.ToArray, conv);
function CombineSyncQueue2<TInp1, TInp2, TRes>(conv: Func<TInp1, TInp2, Context, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>) := new ConvSyncQueueArray2<TInp1, TInp2, TRes>(q1, q2, conv);
function CombineSyncQueue3<TInp1, TInp2, TInp3, TRes>(conv: Func<TInp1, TInp2, TInp3, Context, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>) := new ConvSyncQueueArray3<TInp1, TInp2, TInp3, TRes>(q1, q2, q3, conv);
function CombineSyncQueue4<TInp1, TInp2, TInp3, TInp4, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, Context, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>) := new ConvSyncQueueArray4<TInp1, TInp2, TInp3, TInp4, TRes>(q1, q2, q3, q4, conv);
function CombineSyncQueue5<TInp1, TInp2, TInp3, TInp4, TInp5, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TInp5, Context, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>; q5: CommandQueue<TInp5>) := new ConvSyncQueueArray5<TInp1, TInp2, TInp3, TInp4, TInp5, TRes>(q1, q2, q3, q4, q5, conv);
function CombineSyncQueue6<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, Context, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>; q5: CommandQueue<TInp5>; q6: CommandQueue<TInp6>) := new ConvSyncQueueArray6<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TRes>(q1, q2, q3, q4, q5, q6, conv);
function CombineSyncQueue7<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TInp7, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TInp7, Context, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>; q5: CommandQueue<TInp5>; q6: CommandQueue<TInp6>; q7: CommandQueue<TInp7>) := new ConvSyncQueueArray7<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TInp7, TRes>(q1, q2, q3, q4, q5, q6, q7, conv);
{$endregion Context}
{$endregion Conv}
{$endregion Sync}
{$region Async}
{$region NonConv}
function CombineAsyncQueueBase(params qs: array of CommandQueueBase) := new SimpleAsyncQueueArray<object>(QueueArrayUtils.FlattenAsyncQueueArray(qs));
function CombineAsyncQueueBase(qs: sequence of CommandQueueBase) := new SimpleAsyncQueueArray<object>(QueueArrayUtils.FlattenAsyncQueueArray(qs));
function CombineAsyncQueue<T>(qs: sequence of CommandQueueBase; last: CommandQueue<T>) := new SimpleAsyncQueueArray<T>(QueueArrayUtils.FlattenAsyncQueueArray(qs.Append(last as CommandQueueBase)));
function CombineAsyncQueue<T>(params qs: array of CommandQueue<T>) := new SimpleAsyncQueueArray<T>(QueueArrayUtils.FlattenAsyncQueueArray(qs.Cast&<CommandQueueBase>));
function CombineAsyncQueue<T>(qs: sequence of CommandQueue<T>) := new SimpleAsyncQueueArray<T>(QueueArrayUtils.FlattenAsyncQueueArray(qs.Cast&<CommandQueueBase>));
{$endregion NonConv}
{$region Conv}
{$region NonContext}
function CombineAsyncQueue<TRes>(conv: Func<array of object, TRes>; params qs: array of CommandQueueBase) := new ConvAsyncQueueArray<object, TRes>(qs.Select(q->q.Cast&<object>).ToArray, (a,c)->conv(a));
function CombineAsyncQueue<TRes>(conv: Func<array of object, TRes>; qs: sequence of CommandQueueBase) := new ConvAsyncQueueArray<object, TRes>(qs.Select(q->q.Cast&<object>).ToArray, (a,c)->conv(a));
function CombineAsyncQueue<TInp, TRes>(conv: Func<array of TInp, TRes>; params qs: array of CommandQueue<TInp>) := new ConvAsyncQueueArray<TInp, TRes>(qs.ToArray, (a,c)->conv(a));
function CombineAsyncQueue<TInp, TRes>(conv: Func<array of TInp, TRes>; qs: sequence of CommandQueue<TInp>) := new ConvAsyncQueueArray<TInp, TRes>(qs.ToArray, (a,c)->conv(a));
function CombineAsyncQueue2<TInp1, TInp2, TRes>(conv: Func<TInp1, TInp2, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>) := new ConvAsyncQueueArray2<TInp1, TInp2, TRes>(q1, q2, (o1, o2, c)->conv(o1, o2));
function CombineAsyncQueue3<TInp1, TInp2, TInp3, TRes>(conv: Func<TInp1, TInp2, TInp3, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>) := new ConvAsyncQueueArray3<TInp1, TInp2, TInp3, TRes>(q1, q2, q3, (o1, o2, o3, c)->conv(o1, o2, o3));
function CombineAsyncQueue4<TInp1, TInp2, TInp3, TInp4, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>) := new ConvAsyncQueueArray4<TInp1, TInp2, TInp3, TInp4, TRes>(q1, q2, q3, q4, (o1, o2, o3, o4, c)->conv(o1, o2, o3, o4));
function CombineAsyncQueue5<TInp1, TInp2, TInp3, TInp4, TInp5, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TInp5, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>; q5: CommandQueue<TInp5>) := new ConvAsyncQueueArray5<TInp1, TInp2, TInp3, TInp4, TInp5, TRes>(q1, q2, q3, q4, q5, (o1, o2, o3, o4, o5, c)->conv(o1, o2, o3, o4, o5));
function CombineAsyncQueue6<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>; q5: CommandQueue<TInp5>; q6: CommandQueue<TInp6>) := new ConvAsyncQueueArray6<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TRes>(q1, q2, q3, q4, q5, q6, (o1, o2, o3, o4, o5, o6, c)->conv(o1, o2, o3, o4, o5, o6));
function CombineAsyncQueue7<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TInp7, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TInp7, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>; q5: CommandQueue<TInp5>; q6: CommandQueue<TInp6>; q7: CommandQueue<TInp7>) := new ConvAsyncQueueArray7<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TInp7, TRes>(q1, q2, q3, q4, q5, q6, q7, (o1, o2, o3, o4, o5, o6, o7, c)->conv(o1, o2, o3, o4, o5, o6, o7));
{$endregion NonContext}
{$region Context}
function CombineAsyncQueue<TRes>(conv: Func<array of object, Context, TRes>; params qs: array of CommandQueueBase) := new ConvAsyncQueueArray<object, TRes>(qs.Select(q->q.Cast&<object>).ToArray, conv);
function CombineAsyncQueue<TRes>(conv: Func<array of object, Context, TRes>; qs: sequence of CommandQueueBase) := new ConvAsyncQueueArray<object, TRes>(qs.Select(q->q.Cast&<object>).ToArray, conv);
function CombineAsyncQueue<TInp, TRes>(conv: Func<array of TInp, Context, TRes>; params qs: array of CommandQueue<TInp>) := new ConvAsyncQueueArray<TInp, TRes>(qs.ToArray, conv);
function CombineAsyncQueue<TInp, TRes>(conv: Func<array of TInp, Context, TRes>; qs: sequence of CommandQueue<TInp>) := new ConvAsyncQueueArray<TInp, TRes>(qs.ToArray, conv);
function CombineAsyncQueue2<TInp1, TInp2, TRes>(conv: Func<TInp1, TInp2, Context, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>) := new ConvAsyncQueueArray2<TInp1, TInp2, TRes>(q1, q2, conv);
function CombineAsyncQueue3<TInp1, TInp2, TInp3, TRes>(conv: Func<TInp1, TInp2, TInp3, Context, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>) := new ConvAsyncQueueArray3<TInp1, TInp2, TInp3, TRes>(q1, q2, q3, conv);
function CombineAsyncQueue4<TInp1, TInp2, TInp3, TInp4, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, Context, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>) := new ConvAsyncQueueArray4<TInp1, TInp2, TInp3, TInp4, TRes>(q1, q2, q3, q4, conv);
function CombineAsyncQueue5<TInp1, TInp2, TInp3, TInp4, TInp5, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TInp5, Context, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>; q5: CommandQueue<TInp5>) := new ConvAsyncQueueArray5<TInp1, TInp2, TInp3, TInp4, TInp5, TRes>(q1, q2, q3, q4, q5, conv);
function CombineAsyncQueue6<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, Context, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>; q5: CommandQueue<TInp5>; q6: CommandQueue<TInp6>) := new ConvAsyncQueueArray6<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TRes>(q1, q2, q3, q4, q5, q6, conv);
function CombineAsyncQueue7<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TInp7, TRes>(conv: Func<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TInp7, Context, TRes>; q1: CommandQueue<TInp1>; q2: CommandQueue<TInp2>; q3: CommandQueue<TInp3>; q4: CommandQueue<TInp4>; q5: CommandQueue<TInp5>; q6: CommandQueue<TInp6>; q7: CommandQueue<TInp7>) := new ConvAsyncQueueArray7<TInp1, TInp2, TInp3, TInp4, TInp5, TInp6, TInp7, TRes>(q1, q2, q3, q4, q5, q6, q7, conv);
{$endregion Context}
{$endregion Conv}
{$endregion Async}
{$endregion CombineQueue's}
end.

7687
TestSuite/formatter_tests/input/OpenCLABCBase.pas Normal file
View file

File diff suppressed because it is too large Load diff

18
TestSuite/formatter_tests/input/OpenGLABC.pas Normal file
View file

@ -0,0 +1,18 @@
///
///Модуль, зарезервированный для высокоуровневой оболочки модуля OpenGL
///
unit OpenGLABC;
interface
uses OpenGL;
uses OpenGLABCBase;
implementation
begin
Writeln('OpenGLABC');
Writeln(new System.NotImplementedException);
Readln;
Halt;
end.

4
TestSuite/formatter_tests/input/OpenGLABCBase.pas Normal file
View file

@ -0,0 +1,4 @@
/// Модуль для внутренних типов модуля OpenGLABC
unit OpenGLABCBase;
end.

2635
TestSuite/formatter_tests/input/PABCSystem.pas
View file

File diff suppressed because it is too large Load diff

26
TestSuite/formatter_tests/input/Sounds.pas Normal file
View file

@ -0,0 +1,26 @@
unit Sounds;
{$reference 'PresentationCore.dll'}
procedure PlaySound(fname: string);
begin
var fsound := new System.Windows.Media.MediaPlayer;
fsound.Open(new System.Uri(fname,System.UriKind.RelativeOrAbsolute));
fsound.Play;
end;
type Sound = class
fsound := new System.Windows.Media.MediaPlayer;
public
constructor (fname: string);
begin
Open(fname);
end;
procedure Open(fname: string) := fsound.Open(new System.Uri(fname,System.UriKind.RelativeOrAbsolute));
procedure Play := fsound.Play;
procedure Stop := fsound.Stop;
procedure Pause := fsound.Pause;
procedure Reset := fsound.Position := new System.Timespan(0);
end;
end.

1037
TestSuite/formatter_tests/input/WPFObjects.pas
View file

File diff suppressed because it is too large Load diff

324
TestSuite/formatter_tests/input/graph3d.pas
View file

@ -1,4 +1,4 @@
// Copyright (©) Ivan Bondarev, Stanislav Mihalkovich (for details please see \doc\copyright.txt)
// Copyright (©) Ivan Bondarev, Stanislav Mikhalkovich (for details please see \doc\copyright.txt)
// This code is distributed under the GNU LGPL (for details please see \doc\license.txt)
/// Модуль трёхмерной графики
unit Graph3D;
@ -75,6 +75,8 @@ var
//>> Короткие функции модуля Graph3D # Graph3D short functions
// -----------------------------------------------------
/// Процедура ускорения вывода. Обновляет экран после всех изменений
procedure Redraw(p: ()->());
/// Возвращает цвет по красной, зеленой и синей составляющей (в диапазоне 0..255)
function RGB(r, g, b: byte): Color;
/// Возвращает цвет по красной, зеленой и синей составляющей и параметру прозрачности (в диапазоне 0..255)
@ -180,6 +182,13 @@ type
property ShowCameraInfo: boolean read GetSCI write SetSCI;
/// Отображать ли ViewCube
property ShowViewCube: boolean read GetSVC write SetSVC;
/// Не отображать координатную систему, координатную сетку и ViewCube
procedure HideAll;
begin
ShowCoordinateSystem := False;
ShowGridLines := False;
ShowViewCube := False;
end;
/// Заголовок пространства отображения
property Title: string read GetT write SetT;
/// Подзаголовок пространства отображения
@ -355,6 +364,7 @@ type
rotatetransform := new MatrixTransform3D;
scaletransform := new ScaleTransform3D;
transltransform: TranslateTransform3D;
rotatetransform_absolute := new MatrixTransform3D;
procedure AddToObject3DList;
procedure DeleteFromObject3DList;
@ -368,6 +378,7 @@ type
transfgroup.Children.Add(rotatetransform);
transfgroup.Children.Add(scaletransform);
transfgroup.Children.Add(transltransform);
transfgroup.Children.Add(rotatetransform_absolute);
model.Transform := transfgroup;
hvp.Children.Add(model);
@ -406,10 +417,18 @@ type
begin
Result := CreateObject;
Result.CloneChildren(Self);
var ind := (model.Transform as Transform3DGroup).Children.IndexOf(rotatetransform);
(Result.model.Transform as Transform3DGroup).Children[ind] := (model.Transform as Transform3DGroup).Children[ind].Clone;
Result.rotatetransform := (Result.model.Transform as Transform3DGroup).Children[ind] as MatrixTransform3d;
ind := transfgroup.Children.IndexOf(rotatetransform_absolute);
(Result.model.Transform as Transform3DGroup).Children[ind] := (model.Transform as Transform3DGroup).Children[ind].Clone;
Result.rotatetransform_absolute := (Result.model.Transform as Transform3DGroup).Children[ind] as MatrixTransform3d;
ind := transfgroup.Children.IndexOf(transltransform);
(Result.model.Transform as Transform3DGroup).Children[ind] := (model.Transform as Transform3DGroup).Children[ind].Clone;
Result.transltransform := (Result.model.Transform as Transform3DGroup).Children[ind] as TranslateTransform3D;
//(Result.model.Transform as Transform3DGroup).Children[1] := (model.Transform as Transform3DGroup).Children[1].Clone;
//(Result.model.Transform as Transform3DGroup).Children[2] := (model.Transform as Transform3DGroup).Children[2].Clone;
//(Result.model.Transform as Transform3DGroup).Children[3] := (model.Transform as Transform3DGroup).Children[3].Clone; //- почему-то это не нужно!!! с ним не работает!
@ -424,6 +443,10 @@ type
property Y: real read GetY write SetY;
/// Координата Z
property Z: real read GetZ write SetZ;
/// Направление движения (используется методом MoveTime)
auto property Direction: Vector3D;
/// Скорость в направлении Direction
auto property Velocity: real := 3;
/// Перемещает 3D-объект к точке (xx,yy,zz)
function MoveTo(xx, yy, zz: real): Object3D :=
Invoke&<Object3D>(()->begin
@ -444,6 +467,20 @@ type
function MoveOnY(dy: real): Object3D := MoveOn(0, dy, 0);
/// Перемещает z-координату 3D-объекта на dz
function MoveOnZ(dz: real): Object3D := MoveOn(0, 0, dz);
/// Перемещает 3D-объект вдоль вектора Direction со скоростью Velocity за время dt
procedure MoveTime(dt: real); virtual;
begin
var dx := Direction.X;
var dy := Direction.Y;
var dz := Direction.Z;
var len := Sqrt(dx*dx+dy*dy+dz*dz);
if len = 0 then
exit;
var dvx := dx/len*Velocity;
var dvy := dy/len*Velocity;
var dvz := dz/len*Velocity;
MoveOn(dvx*dt,dvy*dt,dvz*dt);
end;
/// Цвет 3D-объекта
property Color: GColor read GetColor write SetColor; virtual;
private
@ -453,6 +490,24 @@ type
/// Позиция 3D-объекта
property Position: Point3D read GetPos write MoveToProp;
/// Будущая позиция 3D-объекта по прошествии времени dt
function PositionAfterTime(dt: real): Point3D;
begin
var dx := Direction.X;
var dy := Direction.Y;
var dz := Direction.Z;
var len := Sqrt(dx*dx+dy*dy+dz*dz);
if len = 0 then
begin
Result := Position;
exit;
end;
var dvx := dx/len*Velocity;
var dvy := dy/len*Velocity;
var dvz := dz/len*Velocity;
Result := P3D(X + dvx*dt, Y + dvy*dt, Z + dvz*dt);
end;
/// Масштабирует 3D-объект в f раз
function Scale(f: real): Object3D :=
Invoke&<Object3D>(()->begin
@ -489,7 +544,7 @@ type
transfgroup.Children[ind] := rotatetransform;
Result := Self;
end);
/// Поворачивает объект на угол angle вокруг оси axis относительно точки center
/// Поворачивает объект на угол angle вокруг оси axis относительно точки center (её координаты задаются относительно центра объекта)
function RotateAt(axis: Vector3D; angle: real; center: Point3D): Object3D :=
Invoke&<Object3D>(()->begin
var m := Matrix3D.Identity;
@ -499,6 +554,16 @@ type
transfgroup.Children[ind] := rotatetransform;
Result := Self;
end);
/// Поворачивает объект на угол angle вокруг оси axis относительно точки center (в абсолютных координатах)
function RotateAtAbsolute(axis: Vector3D; angle: real; center: Point3D): Object3D :=
Invoke&<Object3D>(()->begin
var m := Matrix3D.Identity;
m.RotateAt(new Quaternion(axis, angle), center);
var ind := transfgroup.Children.IndexOf(rotatetransform_absolute);
rotatetransform_absolute := new MatrixTransform3D(rotatetransform_absolute.Value * m);
transfgroup.Children[ind] := rotatetransform_absolute;
Result := Self;
end);
/// Возвращает анимацию перемещения объекта к точке (x, y, z) за seconds секунд. В конце анимации выполняется процедура Completed
function AnimMoveTo(x, y, z: real; seconds: real; Completed: procedure): AnimationBase;
/// Возвращает анимацию перемещения объекта к точке (x, y, z) за seconds секунд
@ -571,10 +636,14 @@ type
/// Возвращает анимацию поворота объекта вокруг вектора v, направленного из центра объекта, на величину angle за seconds секунд
function AnimRotate(v: Vector3D; angle: real; seconds: real := 1) := AnimRotate(v.x, v.y, v.z, angle, seconds, nil);
/// Возвращает анимацию поворота объекта вокруг вектора axis, направленного из точки center, на величину angle за seconds секунд. В конце анимации выполняется процедура Completed
/// Возвращает анимацию поворота объекта вокруг вектора axis, направленного из точки center (её координаты задаются относительно центра объекта), на величину angle за seconds секунд. В конце анимации выполняется процедура Completed
function AnimRotateAt(axis: Vector3D; angle: real; center: Point3D; seconds: real; Completed: procedure): AnimationBase;
/// Возвращает анимацию поворота объекта вокруг вектора axis, направленного из точки center, на величину angle за seconds секунд
/// Возвращает анимацию поворота объекта вокруг вектора axis, направленного из точки center (её координаты задаются относительно центра объекта), на величину angle за seconds секунд
function AnimRotateAt(axis: Vector3D; angle: real; center: Point3D; seconds: real := 1): AnimationBase := AnimRotateAt(axis,angle,center,seconds,nil);
/// Возвращает анимацию поворота объекта вокруг вектора axis, направленного из точки center (в абсолютных координатах), на величину angle за seconds секунд. В конце анимации выполняется процедура Completed
function AnimRotateAtAbsolute(axis: Vector3D; angle: real; center: Point3D; seconds: real; Completed: procedure): AnimationBase;
/// Возвращает анимацию поворота объекта вокруг вектора axis, направленного из точки center (в абсолютных координатах), на величину angle за seconds секунд
function AnimRotateAtAbsolute(axis: Vector3D; angle: real; center: Point3D; seconds: real := 1): AnimationBase := AnimRotateAtAbsolute(axis,angle,center,seconds,nil);
/// Клонирует 3D-объект
function Clone: Object3D := Invoke&<Object3D>(CloneT);
@ -671,6 +740,10 @@ type
public
/// Добавить дочерний подобъект
procedure AddChild(obj: Object3D) := Invoke(AddT, obj);
/// Добавить дочерний подобъект
procedure AddChilds(params arr: array of Object3D) := arr.ForEach(obj->AddChild(obj));
/// Удалить дочерний подобъект
procedure RemoveChild(obj: Object3D) := Invoke(RemoveT, obj);
/// i-тый дочерний подобъект
property Items[i: integer]: Object3D read GetObj; default;
@ -755,7 +828,8 @@ type
Group3D = class(ObjectWithChildren3D)
protected
function CreateObject: Object3D; override := new Group3D(X, Y, Z);
public
//public
protected
constructor(x, y, z: real) := CreateBase0(new ModelVisual3D, x, y, z);
constructor(x, y, z: real; lst: sequence of Object3D);
@ -764,6 +838,14 @@ type
foreach var xx in lst do
AddChild(xx);
end;
public
procedure UnGroup;
begin
for var i := l.Count-1 downto 0 do
begin
RemoveChild(l[i]);
end;
end;
/// ВОзвращает клон группы 3D-объектов
function Clone := (inherited Clone) as Group3D;
@ -889,6 +971,11 @@ type
Self.AnimationCompleted := act;
Result := Self;
end;
function Clone: AnimationBase; virtual;
begin
Result := Self;
end;
private
procedure BeginT;
@ -939,7 +1026,7 @@ type
EmptyAnimation = class(AnimationBase)
public
constructor(wait: real) := Seconds := wait;
procedure InitAnim(); virtual := InitAnimWait;
procedure InitAnim(); override := InitAnimWait;
end;
@ -954,6 +1041,8 @@ type
v := value;
end;
function Clone: AnimationBase; override := new Double1AnimationBase(Element,Seconds,v,nil);
function AutoReverse: AnimationBase; override;
begin
ApplyDecorators.Add(()-> begin
@ -1000,6 +1089,8 @@ type
(x, y, z) := (xx, yy, zz);
end;
function Clone: AnimationBase; override := new Double3AnimationBase(Element,Seconds,x,y,z,nil);
function AutoReverse: AnimationBase; override;
begin
ApplyDecorators.Add(()-> begin
@ -1069,6 +1160,7 @@ type
daz.Completed += Hand;
end;
public
function Clone: AnimationBase; override := new OffsetAnimationOn(Element,Seconds,x,y,z,nil);
end;
OffsetAnimation = class(OffsetAnimationOn)
@ -1084,6 +1176,7 @@ type
daz.Completed += Hand;
end;
public
function Clone: AnimationBase; override := new OffsetAnimation(Element,Seconds,x,y,z,nil);
end;
OffsetAnimationUsingKeyframes = class(Double3AnimationBase)
@ -1119,6 +1212,8 @@ type
inherited Create(e, sec, Completed);
a := aa;
end;
function Clone: AnimationBase; override := new OffsetAnimationUsingKeyframes(Element,Seconds,a,nil);
end;
ScaleAnimation = class(Double3AnimationBase)
@ -1127,10 +1222,13 @@ type
el: ScaleTransform3D;
procedure Hand(o: object; e: System.EventArgs);
begin
var el0 := Element.scaletransform;
el0.ScaleX += el.ScaleX;
el0.ScaleY += el.ScaleY;
el0.ScaleZ += el.ScaleZ;
if not dax.AutoReverse then
begin
var el0 := Element.scaletransform;
el0.ScaleX += el.ScaleX;
el0.ScaleY += el.ScaleY;
el0.ScaleZ += el.ScaleZ;
end;
Element.transfgroup.Children.Remove(el);
if Completed <> nil then
Completed();
@ -1153,6 +1251,7 @@ type
inherited Create(e, sec, Completed);
scale := sc;
end;
function Clone: AnimationBase; override := new ScaleAnimation(Element,Seconds,scale,nil);
end;
ScaleXAnimation = class(Double1AnimationBase)
@ -1161,8 +1260,11 @@ type
el: ScaleTransform3D;
procedure Hand(o: object; e: System.EventArgs);
begin
var el0 := Element.scaletransform;
el0.ScaleX += el.ScaleX;
if not da.AutoReverse then
begin
var el0 := Element.scaletransform;
el0.ScaleX += el.ScaleX;
end;
Element.transfgroup.Children.Remove(el);
if Completed <> nil then
Completed();
@ -1183,14 +1285,18 @@ type
inherited Create(e, sec, Completed);
scale := sc;
end;
function Clone: AnimationBase; override := new ScaleXAnimation(Element,Seconds,scale,nil);
end;
ScaleYAnimation = class(ScaleXAnimation)
private
procedure Hand(o: object; e: System.EventArgs);
begin
var el0 := Element.scaletransform;
el0.ScaleY += el.ScaleY;
if not da.AutoReverse then
begin
var el0 := Element.scaletransform;
el0.ScaleY += el.ScaleY;
end;
Element.transfgroup.Children.Remove(el);
if Completed <> nil then
Completed();
@ -1205,14 +1311,19 @@ type
da := AddDoubleAnimByName(sb, scale, seconds, ttname, ScaleTransform3D.ScaleYProperty);
da.Completed += Hand;
end;
public
function Clone: AnimationBase; override := new ScaleYAnimation(Element,Seconds,scale,nil);
end;
ScaleZAnimation = class(ScaleXAnimation)
private
procedure Hand(o: object; e: System.EventArgs);
begin
var el0 := Element.scaletransform;
el0.ScaleZ += el.ScaleZ;
if not da.AutoReverse then
begin
var el0 := Element.scaletransform;
el0.ScaleZ += el.ScaleZ;
end;
Element.transfgroup.Children.Remove(el);
if Completed <> nil then
Completed();
@ -1227,6 +1338,8 @@ type
da := AddDoubleAnimByName(sb, scale, seconds, ttname, ScaleTransform3D.ScaleZProperty);
da.Completed += Hand;
end;
public
function Clone: AnimationBase; override := new ScaleZAnimation(Element,Seconds,scale,nil);
end;
RotateAtAnimation = class(Double1AnimationBase)
@ -1237,7 +1350,13 @@ type
procedure Hand(o: object; e: System.EventArgs);
begin
var rot := el.Rotation as AxisAngleRotation3D;
Element.RotateAt(rot.Axis, angle, center);
if not da.AutoReverse then
begin
if Absolute then
Element.RotateAtAbsolute(rot.Axis, angle, center)
else
Element.RotateAt(rot.Axis, angle, center);
end;
Element.transfgroup.Children.Remove(el);
if Completed <> nil then
Completed();
@ -1247,8 +1366,10 @@ type
begin
el := new RotateTransform3D();
el.Rotation := new AxisAngleRotation3D();
Element.transfgroup.Children.Insert(0,el); // До основной матрицы, связанной с поворотом
if Absolute then
Element.transfgroup.Children.Add(el) // После основной матрицы, связанной с поворотом
else Element.transfgroup.Children.Insert(0,el); // До основной матрицы, связанной с поворотом
var rottransform := el;
rottransform.CenterX := center.x;
rottransform.CenterY := center.y;
@ -1273,6 +1394,19 @@ type
inherited Create(e, sec, Completed);
(vx, vy, vz, angle, center) := (vvx, vvy, vvz, a, c)
end;
public
auto property Absolute: boolean;
function Clone: AnimationBase; override := new RotateAtAnimation(Element,Seconds,vx,vy,vz,angle,center,nil);
end;
RotateAtAbsoluteAnimation = class(RotateAtAnimation)
public
constructor(e: Object3D; sec: real; vvx, vvy, vvz, a: real; c: Point3D; Completed: procedure := nil);
begin
inherited Create(e,sec,vvx,vvy,vvz,a,c,Completed);
Absolute := True;
end;
function Clone: AnimationBase; override := new RotateAtAbsoluteAnimation(Element,Seconds,vx,vy,vz,angle,center,nil);
end;
CompositeAnimation = class(AnimationBase)
@ -1281,6 +1415,13 @@ type
public
constructor(params l: array of AnimationBase) := ll := Lst(l);
constructor(l: List<AnimationBase>) := ll := l;
function Clone: AnimationBase; override;
begin
var r := new CompositeAnimation(new List<AnimationBase>());
for var i := 0 to ll.Count-1 do
r.ll.Add(ll[i].Clone);
Result := r;
end;
end;
GroupAnimation = class(CompositeAnimation)
@ -1318,7 +1459,8 @@ type
Result := a;
end;
procedure BeginT;
begin
begin
//Println(Self.GetType+' '+ll.Count);
for var ii:=0 to ll.Count-2 do
begin
var i := ii; // параметр цикла неправильно захватывается лямбдой
@ -1326,14 +1468,24 @@ type
// Если ll[i] - CompositeAnimation, то надо повесить Completed на самую правую не CompositeAnimation
var lf := ll[i];
var llf := ll;
var lli := i;
while lf is CompositeAnimation do
begin
var ca := lf as CompositeAnimation;
lf := ca.ll[ca.ll.Count-1];
llf := ca.ll;
lli := ca.ll.Count-1;
end;
// lf надо в любом случае клонировать
// Клонируем. Надо еще списки клонировать! А то в a+a во втором списке последний элемент - клонированный - в обоих списках!
//lf := lf.Clone;
llf[lli] := lf;
lf.Completed += procedure ->
begin
//Print('Completed '+lf.GetType.ToString);
//Println(i+1);
lll[i+1].Begin;
end;
end;
@ -1373,8 +1525,8 @@ type
protected
function CreateObject: Object3D; override := new SphereT(X, Y, Z, Radius, Material.Clone);
constructor := CreateBase(NewVisualObject(1), 0, 0, 0, Materialhelper.CreateMaterial(Colors.Blue));
constructor(x, y, z, r: real; m: Gmaterial) := CreateBase(NewVisualObject(r), x, y, z, m);
public
constructor(x, y, z, r: real; m: Gmaterial) := CreateBase(NewVisualObject(r), x, y, z, m);
/// Радиус сферы
property Radius: real read GetR write SetR;
/// Возвращает клон сферы
@ -2054,15 +2206,15 @@ type
procedure SetN(n: integer);
function GetN: integer;
protected
function CreateObject: Object3D; override := new PrismT(X, Y, Z, N, Radius, Height, Material.Clone);
function CreateObject: Object3D; override := new PrismT(X, Y, Z, Sides, Radius, Height, Material.Clone);
public
constructor(x, y, z: real; N: integer; r, h: real; m: Gmaterial);
/// Радиус правильной призмы
property Radius: real read GetR write SetR;
/// Высота правильной призмы
property Height: real read GetH write SetH;
/// Количество углов правильной призмы
property N: integer read GetN write SetN;
/// Количество боковых граней правильной призмы
property Sides: integer read GetN write SetN;
/// Возвращает клон правильной призмы
function Clone := (inherited Clone) as PrismT;
end;
@ -2074,15 +2226,15 @@ type
PyramidT = class(PrismT)
private
protected
function CreateObject: Object3D; override := new PyramidT(X, Y, Z, N, Radius, Height, Material.Clone);
function CreateObject: Object3D; override := new PyramidT(X, Y, Z, Sides, Radius, Height, Material.Clone);
public
constructor(x, y, z: real; N: integer; r, h: real; m: GMaterial);
/// Радиус правильной пирамиды
property Radius: real read GetR write SetR;
/// Высота правильной пирамиды
property Height: real read GetH write SetH;
/// Количество углов правильной пирамиды
property N: integer read GetN write SetN;
/// Количество боковых граней правильной пирамиды
property Sides: integer read GetN write SetN;
/// Возвращает клон правильной пирамиды
function Clone := (inherited Clone) as PyramidT;
end;
@ -2136,8 +2288,8 @@ type
begin
var pc := new Point3DCollection;
var a := Partition(0, 2 * Pi, N).Select(x -> P3D(fr * cos(x), fr * sin(x), 0)).ToArray;
var b := Partition(0, 2 * Pi, N).Select(x -> P3D(fr * cos(x), fr * sin(x), fh)).ToArray;
var a := PartitionPoints(0, 2 * Pi, Sides).Select(x -> P3D(fr * cos(x), fr * sin(x), 0)).ToArray;
var b := PartitionPoints(0, 2 * Pi, Sides).Select(x -> P3D(fr * cos(x), fr * sin(x), fh)).ToArray;
for var i := 0 to a.High - 1 do
begin
pc.Add(a[i]);
@ -2168,12 +2320,12 @@ type
end;
protected
function CreateObject: Object3D; override := new PrismTWireframe(X, Y, Z, N, Radius, Height, (model as LinesVisual3D).Thickness, (model as LinesVisual3D).Color);
function CreateObject: Object3D; override := new PrismTWireframe(X, Y, Z, Sides, Radius, Height, (model as LinesVisual3D).Thickness, (model as LinesVisual3D).Color);
public
function Points: Point3DCollection; virtual;
begin
var a := Partition(0, 2 * Pi, N).Select(x -> P3D(fr * cos(x), fr * sin(x), 0)).SkipLast;
var b := Partition(0, 2 * Pi, N).Select(x -> P3D(fr * cos(x), fr * sin(x), fh)).SkipLast;
var a := PartitionPoints(0, 2 * Pi, Sides).Select(x -> P3D(fr * cos(x), fr * sin(x), 0)).SkipLast;
var b := PartitionPoints(0, 2 * Pi, Sides).Select(x -> P3D(fr * cos(x), fr * sin(x), fh)).SkipLast;
var pc := new Point3DCollection(a + b);
Result := pc;
@ -2186,8 +2338,8 @@ type
property Radius: real read fr write SetR;
/// Высота проволочной правильной призмы
property Height: real read fh write SetH;
/// Количество углов проволочной правильной призмы
property N: integer read fn write SetN;
/// Количество боковых граней проволочной правильной призмы
property Sides: integer read fn write SetN;
/// Цвет проволоки правильной призмы
property Color: GColor read GetC write SetC; override;
/// Толщина проволоки правильной призмы
@ -2200,13 +2352,13 @@ type
/// Класс проволочной правильной пирамиды
PyramidTWireframe = class(PrismTWireframe)
protected
function CreateObject: Object3D; override := new PyramidTWireframe(X, Y, Z, N, Radius, Height, (model as LinesVisual3D).Thickness, (model as LinesVisual3D).Color);
function CreateObject: Object3D; override := new PyramidTWireframe(X, Y, Z, Sides, Radius, Height, (model as LinesVisual3D).Thickness, (model as LinesVisual3D).Color);
private
function CreatePoints: Point3DCollection; override;
begin
var pc := new Point3DCollection;
var a := Partition(0, 2 * Pi, N).Select(x -> P3D(fr * cos(x), fr * sin(x), 0)).ToArray;
var a := PartitionPoints(0, 2 * Pi, Sides).Select(x -> P3D(fr * cos(x), fr * sin(x), 0)).ToArray;
var b := P3D(0, 0, fh);
for var i := 0 to a.High - 1 do
begin
@ -2225,8 +2377,8 @@ type
property Radius: real read fr write SetR;
/// Высота проволочной правильной пирамиды
property Height: real read fh write SetH;
/// Количество углов проволочной правильной пирамиды
property N: integer read fn write SetN;
/// Количество боковых граней проволочной правильной пирамиды
property Sides: integer read fn write SetN;
/// Цвет проволоки правильной пирамиды
property Color: GColor read GetC write SetC; override;
/// Толщина проволоки правильной пирамиды
@ -2332,9 +2484,9 @@ function Sphere(center: Point3D; Radius: real; m: Material := DefaultMaterial):
function Ellipsoid(x, y, z, RadiusX, RadiusY, RadiusZ: real; m: Material := DefaultMaterial): EllipsoidT;
/// Возвращает эллипсоид с центром в точке center и радиусами RadiusX, RadiusY, RadiusZ
function Ellipsoid(center: Point3D; RadiusX, RadiusY, RadiusZ: real; m: Material := DefaultMaterial): EllipsoidT;
/// Возвращает эллипсоид с центром в точке (x, y, z) и длиной стороны SideLength
/// Возвращает куб с центром в точке (x, y, z) и длиной стороны SideLength
function Cube(x, y, z, SideLength: real; m: Material := DefaultMaterial): CubeT;
/// Возвращает эллипсоид с центром в точке center и длиной стороны SideLength
/// Возвращает куб с центром в точке center и длиной стороны SideLength
function Cube(center: Point3D; SideLength: real; m: Material := DefaultMaterial): CubeT;
/// Возвращает паралеллепипед с центром в точке (x, y, z) и размерами SizeX, SizeY, SizeZ
function Box(x, y, z, SizeX, SizeY, SizeZ: real; m: Material := DefaultMaterial): BoxT;
@ -2492,6 +2644,9 @@ function EmptyAnim(sec: real): EmptyAnimation;
// -----------------------------------------------------
//>> Graph3D: функции для определения ближайших точек и объектов # Graph3D functions for nearest points and objects
// -----------------------------------------------------
/// Создаёт траекторию в виде массива точек, заданную параметрически. Функция fun отображает параметр t на координаты точки в пространстве
function ParametricTrajectory(a,b: real; N: integer; fun: real->Point3D): sequence of Point3D;
/// Возвращает ближайший 3D-объект, который пересекает луч, выпущенный из камеры и проходящий через точку (x,y) экрана
function FindNearestObject(x, y: real): Object3D;
@ -2504,6 +2659,12 @@ function PointOnPlane(Plane: Plane3D; x, y: real): Point3D;
/// Возвращает ближайшую точку на линии Line с лучом, выпущенным из камеры и проходящем через точку (x,y) экрана
function NearestPointOnLine(Line: Ray3D; x, y: real): Point3D;
/// Начинает анимацию, основанную на кадре, и передаёт в каждый обработчик кадра время dt, прошедшее с момента последней перерисовки
procedure BeginFrameBasedAnimationTime(Draw: procedure(dt: real));
/// Заканчивает анимацию, основанную на кадре
procedure EndFrameBasedAnimation;
var
// -----------------------------------------------------
//>> События модуля Graph3D # Graph3D events
@ -2518,6 +2679,13 @@ var
OnKeyDown: procedure(k: Key);
/// Событие отжатия клавиши
OnKeyUp: procedure(k: Key);
/// Событие нажатия символьной клавиши
OnKeyPress: procedure(ch: char);
/// Событие перерисовки графического 3D-окна.
///Инициализируется процедурой с вещественным параметром dt - временем, прошедшим с момента последнего обновления экрана
OnDrawFrame: procedure(dt: real);
/// Событие, происходящее при закрытии основного окна
var OnClose: procedure;
var
// -----------------------------------------------------
@ -2541,6 +2709,8 @@ var
OrtY: Vector3D := V3D(0, 1, 0);
/// Орт (единичный вектор) оси OZ
OrtZ: Vector3D := V3D(0, 0, 1);
/// Нулевой вектор
ZeroVector: Vector3D := V3D(0, 0, 0);
/// Точка начала координат
Origin: Point3D := P3D(0, 0, 0);
/// Плоскость OXY
@ -2567,6 +2737,8 @@ procedure __FinalizeModule__;
implementation
procedure Redraw(p: ()->()) := GraphWPFBase.Invoke(p);
function RGB(r, g, b: byte) := Color.Fromrgb(r, g, b);
function ARGB(a, r, g, b: byte) := Color.FromArgb(a, r, g, b);
function P3D(x, y, z: real) := new Point3D(x, y, z);
@ -2637,6 +2809,8 @@ function Object3D.AnimRotate(vx, vy, vz, angle, seconds: real; Completed: proced
function Object3D.AnimRotateAt(axis: Vector3D; angle: real; center: Point3D; seconds: real; Completed: procedure) := new RotateAtAnimation(Self, seconds, axis.X, axis.y, axis.z, angle, center, Completed);
function Object3D.AnimRotateAtAbsolute(axis: Vector3D; angle: real; center: Point3D; seconds: real; Completed: procedure) := new RotateAtAbsoluteAnimation(Self, seconds, axis.X, axis.y, axis.z, angle, center, Completed);
procedure Object3D.AddToObject3DList := Object3DList.Add(Self);
procedure Object3D.DeleteFromObject3DList;
@ -2976,8 +3150,8 @@ type
var pmb := new PanelModelBuilder();
if N > 0 then
begin
var a := Partition(0, 2 * Pi, N).Select(x -> P3D(fr * cos(x), fr * sin(x), 0)).ToArray;
var b := Partition(0, 2 * Pi, N).Select(x -> P3D(fr * cos(x), fr * sin(x), fh)).ToArray;
var a := PartitionPoints(0, 2 * Pi, N).Select(x -> P3D(fr * cos(x), fr * sin(x), 0)).ToArray;
var b := PartitionPoints(0, 2 * Pi, N).Select(x -> P3D(fr * cos(x), fr * sin(x), fh)).ToArray;
for var i := 0 to fn - 1 do
pmb.AddPanel(a[i + 1].X, a[i + 1].Y, a[i + 1].Z, a[i].X, a[i].Y, a[i].Z, b[i].X, b[i].Y, b[i].Z, b[i + 1].X, b[i + 1].Y, b[i + 1].Z);
pmb.AddPanel(a.Reverse.ToArray);
@ -2994,7 +3168,7 @@ type
var pmb := new PanelModelBuilder();
if N > 0 then
begin
var a := Partition(0, 2 * Pi, N).Select(x -> P3D(fr * cos(x), fr * sin(x), 0)).ToArray;
var a := PartitionPoints(0, 2 * Pi, N).Select(x -> P3D(fr * cos(x), fr * sin(x), 0)).ToArray;
var top := P3D(0, 0, fh);
for var i := 0 to fn - 1 do
pmb.AddPanel(a[i + 1].X, a[i + 1].Y, a[i + 1].Z, a[i].X, a[i].Y, a[i].Z, top.X, top.Y, top.Z);
@ -3199,19 +3373,19 @@ function FileModel3D(p: Point3D; fname: string; m: Material): FileModelT := File
function Prism(x, y, z: real; Sides: integer; Height, Radius: real; m: Material): PrismT := Inv(()->PrismT.Create(x, y, z, Sides, Radius, Height, m));
function Prism(p: Point3D; Sides: integer; Height, Radius: real; m: Material): PrismT := Prism(p.X, p.Y, p.Z, Sides, Radius, Height, m);
function Prism(p: Point3D; Sides: integer; Height, Radius: real; m: Material): PrismT := Prism(p.X, p.Y, p.Z, Sides, Height, Radius, m);
function PrismWireFrame(x, y, z: real; Sides: integer; Height, Radius: real; Thickness: real; c: Color): PrismTWireFrame := Inv(()->PrismTWireFrame.Create(x, y, z, Sides, Radius, Height, thickness, c));
function PrismWireFrame(p: Point3D; Sides: integer; Height, Radius: real; Thickness: real; c: Color): PrismTWireFrame := PrismWireFrame(p.x, p.y, p.z, Sides, Radius, Height, thickness, c);
function PrismWireFrame(p: Point3D; Sides: integer; Height, Radius: real; Thickness: real; c: Color): PrismTWireFrame := PrismWireFrame(p.x, p.y, p.z, Sides, Height, Radius, thickness, c);
function Pyramid(x, y, z: real; Sides: integer; Height, Radius: real; m: Material): PyramidT := Inv(()->PyramidT.Create(x, y, z, Sides, Radius, Height, m));
function Pyramid(p: Point3D; Sides: integer; Height, Radius: real; m: Material): PyramidT := Pyramid(p.X, p.Y, p.Z, Sides, Radius, Height, m);
function Pyramid(p: Point3D; Sides: integer; Height, Radius: real; m: Material): PyramidT := Pyramid(p.X, p.Y, p.Z, Sides, Height, Radius, m);
function PyramidWireFrame(x, y, z: real; Sides: integer; Height, Radius: real; Thickness: real; c: Color): PyramidTWireFrame := Inv(()->PyramidTWireFrame.Create(x, y, z, Sides, Radius, Height, thickness, c));
function PyramidWireFrame(p: Point3D; Sides: integer; Height, Radius: real; Thickness: real; c: Color): PyramidTWireFrame := PyramidWireFrame(p.x, p.y, p.z, Sides, Radius, Height, thickness, c);
function PyramidWireFrame(p: Point3D; Sides: integer; Height, Radius: real; Thickness: real; c: Color): PyramidTWireFrame := PyramidWireFrame(p.x, p.y, p.z, Sides, Height, Radius, thickness, c);
function Lego(x, y, z: real; Rows, Columns, Height: integer; m: Material): LegoT := Inv(()->LegoT.Create(x, y, z, Rows, Columns, Height, m));
@ -3250,6 +3424,8 @@ function Triangle(p1, p2, p3: Point3D; m: Material): TriangleT := Inv(()->Triang
// Функции для точек, лучей, прямых, плоскостей
function ParametricTrajectory(a,b: real; N: integer; fun: real->Point3D) := PartitionPoints(a,b,N).Select(fun);
function FindNearestObject(x, y: real): Object3D;
begin
Result := nil;
@ -3304,7 +3480,6 @@ function PointOnPlane(Plane: Plane3D; x, y: real): Point3D := Plane.PointOnPlane
function NearestPointOnLine(Line: Ray3D; x, y: real): Point3D := Line.NearestPointOnLine(x,y);
// Методы расширения для анимаций
function Sec(Self: integer): real; extensionmethod := Self;
@ -3581,6 +3756,34 @@ function Any(x, y, z: real; c: Color): AnyT := Inv(()->AnyT.Create(x, y, z, c));
// Сервисные функции и классы
var LastUpdatedTime := new System.TimeSpan(0);
procedure RenderFrame(o: Object; e: System.EventArgs);
begin
if OnDrawFrame<>nil then
begin
var e1 := RenderingEventArgs(e).RenderingTime;
if LastUpdatedTime.Ticks = integer.MinValue then // первый раз
LastUpdatedTime := e1;
var dt := e1 - LastUpdatedTime;
if LastUpdatedTime.TotalMilliseconds<>0 then
if OnDrawFrame<>nil then
OnDrawFrame(dt.Milliseconds/1000);
LastUpdatedTime := e1;
end;
end;
procedure BeginFrameBasedAnimationTime(Draw: procedure(dt: real));
begin
OnDrawFrame := Draw;
end;
procedure EndFrameBasedAnimation;
begin
OnDrawFrame := nil;
end;
type
Graph3DWindow = class(GMainWindow)
public
@ -3631,18 +3834,27 @@ type
/// --- SystemKeyEvents
procedure SystemOnKeyDown(sender: Object; e: System.Windows.Input.KeyEventArgs);
begin
if (e.Key = Key.F4) and (e.KeyboardDevice.Modifiers = ModifierKeys.Control) then
Close;
if Graph3D.OnKeyDown <> nil then
Graph3D.OnKeyDown(e.Key);
e.Handled := True;
end;
procedure SystemOnKeyUp(sender: Object; e: System.Windows.Input.KeyEventArgs) :=
procedure SystemOnKeyUp(sender: Object; e: System.Windows.Input.KeyEventArgs);
begin
if Graph3D.OnKeyUp <> nil then
Graph3D.OnKeyUp(e.Key);
e.Handled := True;
end;
procedure SystemOnKeyPress(sender: Object; e: TextCompositionEventArgs);
begin
if (OnKeyPress<>nil) and (e.Text<>nil) and (e.Text.Length>0) then
OnKeyPress(e.Text[1]);
e.Handled := True;
end;
/// --- SystemMouseEvents
procedure SystemOnMouseDown(sender: Object; e: System.Windows.Input.MouseButtonEventArgs);
begin
@ -3688,9 +3900,16 @@ type
hvp.PreviewKeyDown += (o, e)-> SystemOnKeyDown(o, e);
hvp.PreviewKeyUp += (o, e)-> SystemOnKeyUp(o, e);
hvp.PreviewTextInput += SystemOnKeyPress; // не работает
hvp.Focus();
Closed += procedure(sender, e) -> begin Halt; end;
Closed += procedure(sender, e) -> begin
if OnClose<>nil then
OnClose;
Halt;
end;
CompositionTarget.Rendering += RenderFrame;
end;
end;
@ -3709,8 +3928,7 @@ begin
end;
MainWindow := new Graph3DWindow;
//MainWindow.MainPanel;
mre.Set();
app.Run(MainWindow);

52
TestSuite/formatter_tests/input/Робот.pas Normal file
View file

@ -0,0 +1,52 @@
// Copyright (c) Ivan Bondarev, Stanislav Mikhalkovich (for details please see \doc\copyright.txt)
// This code is distributed under the GNU LGPL (for details please see \doc\license.txt)
///Исполнитель Робот действует на прямоугольном клеточном поле. Между некоторыми клетками, а также по периметру поля находятся стены.
///Основная цель Робота – закрасить указанные клетки и переместиться в конечную клетку.
unit Робот;
uses Robot,RobotField;
procedure Вправо := Right;
procedure Влево := Left;
procedure Вверх := Up;
procedure Вниз := Down;
procedure Закрасить := Paint;
function СправаСвободно := FreeFromRight;
function СлеваСвободно := FreeFromLeft;
function СверхуСвободно := FreeFromUp;
function СнизуСвободно := FreeFromDown;
function СправаСтена := WallFromRight;
function СлеваСтена := WallFromLeft;
function СверхуСтена := WallFromUp;
function СнизуСтена := WallFromDown;
function КлеткаНеЗакрашена := CellIsFree;
function КлеткаЗакрашена := CellIsPainted;
procedure Задание(имя: string) := Task(имя);
procedure СтандартноеПоле := StandardField;
procedure Поле(n,m: integer) := Field(n,m);
begin
HelpStr :=
'Разработчик исполнителя Робот: Михалкович С.С., 2002-17 '#10#13#10#13+
'Команды исполнителя Робот:'#10#13+
' Вправо'#10#13+
' Влево'#10#13
' Вверх'#10#13+
' Вниз'#10#13
' Закрасить - закрасить текущую клетку'#10#13
' Задание(имя) - вызвать задание с указанным именем'#10#13
' СтандартноеПоле - вызвать стандартное поле'#10#13
' Поле(n,m) - вызвать поле размера n на m'#10#13
'Условия, проверяемые исполнителем Робот:'#10#13
' СправаСтена'#10#13
' СлеваСтена'#10#13
' СверхуСтена'#10#13
' СнизуСтена'#10#13
' СправаСвободно'#10#13
' СлеваСвободно'#10#13
' СверхуСвободно'#10#13
' СнизуСвободно'#10#13
' КлеткаЗакрашена'#10#13
' КлеткаНеЗакрашена'#10#13;
end.

29
TestSuite/formatter_tests/input/Чертежник.pas Normal file
View file

@ -0,0 +1,29 @@
// Copyright (c) Ivan Bondarev, Stanislav Mikhalkovich (for details please see \doc\copyright.txt)
// This code is distributed under the GNU LGPL (for details please see \doc\license.txt)
///Исполнитель Чертежник предназначен для построения рисунков и чертежей на плоскости с координатами.
///Чертежник имеет перо, которое он может поднимать, опускать и перемещать. При перемещении опущенного пера за ним остается след.
unit Чертежник;
uses Drawman,DrawManField;
procedure ОпуститьПеро := PenDown;
procedure ПоднятьПеро := PenUp;
procedure КТочке(x,y: integer) := ToPoint(x,y);
procedure НаВектор(a,b: integer) := OnVector(a,b);
procedure Задание(имя: string) := Task(имя);
procedure СтандартноеПоле := StandardField;
procedure Поле(n,m: integer) := Field(n,m);
begin
HelpStr := 'Разработчик исполнителя Чертежник: Михалкович С.С., 2002-17 '#10#13#10#13+
'Команды исполнителя Чертежник:'#10#13+
' ОпуститьПеро'#10#13+
' ПоднятьПеро'#10#13
' КТочке(x,y) - переместиться в точку с координатами (x,y)'#10#13+
' НаВектор(a,b) - переместиться из текущей точки на вектор (a,b)'#10#13
' a>0 - вправо, a<0 - влево, b>0 - вверх, b<0 - вниз'#10#13
' Задание(name) - вызвать задание с указанным именем'#10#13
' СтандартноеПоле - вызвать стандартное поле'#10#13
' Поле(n,m) - вызвать поле размера n на m'#10#13#10#13;
end.