Автоклассы - разрешение наследования от классов без полей
Модуль Coords
This commit is contained in:
Mikhalkovich Stanislav
parent
8f7e92d418
commit
8d51f999a5
|
|
@ -15,7 +15,7 @@ internal static class RevisionClass
|
|||
public const string Major = "3";
|
||||
public const string Minor = "10";
|
||||
public const string Build = "0";
|
||||
public const string Revision = "3538";
|
||||
public const string Revision = "3543";
|
||||
|
||||
public const string MainVersion = Major + "." + Minor;
|
||||
public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision;
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
%COREVERSION%=0
|
||||
%REVISION%=3538
|
||||
%MINOR%=10
|
||||
%REVISION%=3543
|
||||
%COREVERSION%=0
|
||||
%MAJOR%=3
|
||||
|
|
|
|||
Binary file not shown.
|
|
@ -1 +1 @@
|
|||
3.10.0.3538
|
||||
3.10.0.3543
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
!define VERSION '3.10.0.3538'
|
||||
!define VERSION '3.10.0.3543'
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ uses
|
|||
GraphABCHelper,
|
||||
GraphWPFBase,
|
||||
Graph3D,
|
||||
GraphWPF, Turtle, TurtleWPF,
|
||||
GraphWPF, Coords, Turtle, TurtleWPF,
|
||||
WPFObjects,
|
||||
NumLibABC,
|
||||
IniFile, PointerTools, PointRect,
|
||||
|
|
|
|||
|
|
@ -144,6 +144,7 @@
|
|||
File ..\bin\Lib\School.pcu
|
||||
File ..\bin\Lib\SF.pcu
|
||||
File ..\bin\Lib\Turtle.pcu
|
||||
File ..\bin\Lib\Coords.pcu
|
||||
File ..\bin\Lib\TurtleWPF.pcu
|
||||
File ..\bin\Lib\LightPT.pcu
|
||||
File ..\bin\Lib\Tasks.pcu
|
||||
|
|
@ -234,6 +235,7 @@
|
|||
${AddFile} "School.pcu"
|
||||
${AddFile} "SF.pcu"
|
||||
${AddFile} "Turtle.pcu"
|
||||
${AddFile} "Coords.pcu"
|
||||
${AddFile} "TurtleWPF.pcu"
|
||||
${AddFile} "LightPT.pcu"
|
||||
${AddFile} "Tasks.pcu"
|
||||
|
|
@ -347,6 +349,7 @@
|
|||
File ..\bin\Lib\School.pas
|
||||
File ..\bin\Lib\SF.pas
|
||||
File ..\bin\Lib\Turtle.pas
|
||||
File ..\bin\Lib\Coords.pas
|
||||
File ..\bin\Lib\TurtleWPF.pas
|
||||
File ..\bin\Lib\LightPT.pas
|
||||
File ..\bin\Lib\Tasks.pas
|
||||
|
|
@ -424,6 +427,7 @@
|
|||
${AddFile} "School.pas"
|
||||
${AddFile} "SF.pas"
|
||||
${AddFile} "Turtle.pas"
|
||||
${AddFile} "Coords.pas"
|
||||
${AddFile} "TurtleWPF.pas"
|
||||
${AddFile} "LightPT.pas"
|
||||
${AddFile} "Tasks.pas"
|
||||
|
|
|
|||
|
|
@ -4,297 +4,22 @@ unit Turtle;
|
|||
uses GraphWPFBase;
|
||||
uses GraphWPF;
|
||||
uses System.Threading.Tasks;
|
||||
uses Coords;
|
||||
|
||||
type
|
||||
Colors = GraphWPF.Colors;
|
||||
CommandType = (ForwComm,TurnComm,CircleComm,PointComm,PointsComm,UpComm,DownComm,ToPointComm,SetColorComm,SetWidthComm);
|
||||
ICommand = interface
|
||||
procedure Play(dc: DrawingContext);
|
||||
end;
|
||||
{ Command = record
|
||||
typ: CommandType;
|
||||
r,da,x,y: real;
|
||||
points: array of Point;
|
||||
color: GColor;
|
||||
end;
|
||||
}
|
||||
var
|
||||
CurrentPen := ColorPen(Colors.Black,1.4);
|
||||
Palette: array of Color := Arr(Colors.Green, Colors.Blue, Colors.Red, Colors.Orange,
|
||||
Colors.Magenta, Colors.LightGreen, Colors.LightBlue, Colors.Coral, Colors.Gray, Colors.LightGray);
|
||||
PaletteIndex := 0;
|
||||
|
||||
function Pnt(x,y: real): Point := GraphWPF.Pnt(x,y);
|
||||
|
||||
{$region Класс координатной сетки FS}
|
||||
|
||||
var MinLen := 25;
|
||||
var PointRadius := 2.0;
|
||||
|
||||
// Сделаем в логических координатах fso.LineToReal, fso.MoveToReal, fso.CircleReal
|
||||
type
|
||||
FS = class
|
||||
// origin - точка по центру графика в логических координатах
|
||||
origin: Point;
|
||||
// scale - количество пикселей на одну единицу
|
||||
scale: real;
|
||||
mx, my: real;
|
||||
a, b, min, max: real; // реальные координаты [a.b] x [min,max]
|
||||
x, y, w, h: real; // экранные координаты - левый верхний угол, ширина и высота
|
||||
// XTicks, YTicks - сколько логических единиц занимает одно деление (по умолчанию 1)
|
||||
XTicks, YTicks: real;
|
||||
// XTicks = YTicks = FindP(Scale)/Scale
|
||||
// Ticks будет меняться по стратегии: 0.1 0.2 0.5 1 2 5 10
|
||||
MarginY := 6;
|
||||
MarginX := 6;
|
||||
XTicksPrecision := 4;
|
||||
YTicksPrecision := 5;
|
||||
spaceBetweenTextAndGraph := 0;
|
||||
|
||||
constructor (scale, x, y, w, h: real; origin: Point := Pnt(0,0));
|
||||
begin
|
||||
Self.Scale := scale;
|
||||
Self.x := x; Self.y := y; Self.w := w; Self.h := h;
|
||||
Self.origin := origin;
|
||||
CorrectBounds;
|
||||
end;
|
||||
|
||||
function PointInside(p: Point): boolean;
|
||||
begin
|
||||
Result := (p.X >= a) and (p.X <= b) and (p.Y >= min) and (p.Y <= max);
|
||||
end;
|
||||
|
||||
function FindP(Scale: real): real;
|
||||
begin // MinLen = 25 - то самое число
|
||||
var p := Scale;
|
||||
if p < MinLen then
|
||||
while p < MinLen do
|
||||
p *= 10
|
||||
else begin
|
||||
while p >= MinLen * 10 do
|
||||
p /= 10;
|
||||
end;
|
||||
// p in [MinLen..MinLen * 10)
|
||||
if p >= MinLen * 5 then
|
||||
p /= 5
|
||||
else if p >= MinLen *2 then
|
||||
p /= 2;
|
||||
Result := p;
|
||||
end;
|
||||
|
||||
procedure CorrectBounds;
|
||||
begin
|
||||
mx := Scale;
|
||||
my := Scale;
|
||||
a := -w/2/mx;
|
||||
b := -a;
|
||||
max := h/2/my;
|
||||
min := - max;
|
||||
|
||||
XTicks := FindP(Scale)/Scale;
|
||||
YTicks := XTicks;
|
||||
|
||||
var th := TextHeightP('0'); // высота текста
|
||||
// tw - ширина текста - максимум по всем числам
|
||||
var RY0 := GetRY0; // самое маленькое логическое значение по y. Соответствует нижней части экрана
|
||||
var tw := RY0.Step(YTicks).TakeWhile(ry -> ry <= max + origin.y)
|
||||
.Select(y -> TextWidthP(y.Round(YTicksPrecision).ToString)).DefaultIfEmpty.Max;
|
||||
if tw = 0 then
|
||||
tw := TextWidthP('0');
|
||||
var dd := TextWidthP(b.Round(xTicksPrecision).ToString)/2;
|
||||
// dd - это половинка ширины последней цифры
|
||||
//var tw := TextWidth('-99.9');
|
||||
w -= {MarginX * 2 +} spaceBetweenTextAndGraph + tw + dd;
|
||||
h -= MarginY * 2 + spaceBetweenTextAndGraph + th;
|
||||
x += MarginX + spaceBetweenTextAndGraph + tw;
|
||||
y += MarginY;
|
||||
|
||||
// И ещё раз пересчитаем!
|
||||
a := -w/2/mx;
|
||||
b := -a;
|
||||
max := h/2/my;
|
||||
min := - max;
|
||||
|
||||
XTicks := FindP(Scale)/Scale;
|
||||
YTicks := XTicks;
|
||||
end;
|
||||
|
||||
// a,b,min,max - логические
|
||||
function RealToScreenX(xx: real) := x + mx * (xx - origin.x - a);
|
||||
function RealToScreenY(yy: real) := y + h - my * (yy - origin.y - min); // ?
|
||||
function ScreenToRealX(xx: real) := (xx - x) / mx + a + origin.x;
|
||||
function ScreenToRealY(yy: real) := (y + h - yy) / my + min + origin.y;
|
||||
function ScreenToReal(p: Point): Point := Pnt(ScreenToRealX(p.X),ScreenToRealY(p.Y));
|
||||
function RealToScreen(p: Point): Point := Pnt(RealToScreenX(p.X),RealToScreenY(p.Y));
|
||||
|
||||
/// Самое маленькое логическое значение по x
|
||||
function GetRX0: real;
|
||||
begin
|
||||
var xt := XTicks * Trunc(Abs(a + origin.x)/XTicks);
|
||||
var rx0: real;
|
||||
if a + origin.x <= 0 then
|
||||
rx0 := -xt
|
||||
else rx0 := xt + XTicks;
|
||||
Result := rx0;
|
||||
end;
|
||||
|
||||
/// Самое маленькое логическое значение по y
|
||||
function GetRY0: real;
|
||||
begin
|
||||
var yt: real := YTicks * Trunc(Abs(min + origin.y)/YTicks);
|
||||
var ry0: real;
|
||||
if min + origin.y <= 0 then
|
||||
ry0 := -yt
|
||||
else ry0 := yt + YTicks;
|
||||
Result := ry0;
|
||||
end;
|
||||
|
||||
procedure DrawDC(dc: DrawingContext);
|
||||
begin
|
||||
var AxisColor := GrayColor(112);
|
||||
var GridPen := ColorPen(Colors.LightGray,1);
|
||||
var AxisPen := ColorPen(AxisColor,1);
|
||||
|
||||
var stepx := mx * XTicks; // Экранный шаг по оси x
|
||||
var rx0 := GetRX0; // реальная начальная координата по x. При запуске = 14
|
||||
var x0 := RealToScreenX(rx0); // Экранная начальная координата по x.
|
||||
|
||||
// ширина надписи по оси ox
|
||||
var www := PABCSystem.max(TextWidthP(rx0.Round(XTicksPrecision).ToString),
|
||||
TextWidthP((rx0+XTicks).Round(XTicksPrecision).ToString)) + 3;
|
||||
var numTicks := Trunc(w / 2 / stepx);
|
||||
|
||||
var it := 0;
|
||||
if numTicks.IsEven then
|
||||
it += 1;
|
||||
|
||||
while x0<=x+w+0.000001 do
|
||||
begin
|
||||
if Abs(rx0)<0.000001 then
|
||||
dc.DrawLine(AxisPen,Pnt(x0,y),Pnt(x0,y+h))
|
||||
else dc.DrawLine(GridPen,Pnt(x0,y),Pnt(x0,y+h));
|
||||
var text := rx0.Round(XTicksPrecision).ToString;
|
||||
if (www <= stepx) or (it mod 2 = 1) then
|
||||
TextOutDC(dc,x0,y+h+4,text,Alignment.CenterTop);
|
||||
x0 += stepx;
|
||||
rx0 += XTicks;
|
||||
it += 1;
|
||||
end;
|
||||
|
||||
var stepy := my * YTicks;
|
||||
var ry0 := GetRY0;
|
||||
var y0 := RealToScreenY(ry0);
|
||||
|
||||
while y0>=y-0.000001 do
|
||||
begin
|
||||
if Abs(ry0)<0.000001 then
|
||||
DrawLineDC(dc,x,y0,x+w,y0,AxisPen)
|
||||
else DrawLineDC(dc,x,y0,x+w,y0,GridPen);
|
||||
TextOutDC(dc,x-4,y0,ry0.Round(YTicksPrecision).ToString,Alignment.RightCenter);
|
||||
y0 -= stepy;
|
||||
ry0 += YTicks;
|
||||
end;
|
||||
|
||||
DrawRectangleDC(dc, x, y, w, h, nil, ColorPen(Colors.Black,1));
|
||||
end;
|
||||
|
||||
procedure Draw := FastDraw(DrawDC);
|
||||
|
||||
procedure DrawPoints := FastDraw(dc -> begin
|
||||
var sz := 1.2;
|
||||
if Scale < 10 then
|
||||
exit;
|
||||
var a := ScreenToRealX(x); var b := ScreenToRealX(x+w);
|
||||
var min := ScreenToRealY(y+h); var max := ScreenToRealY(y);
|
||||
for var x := Ceil(a) to Floor(b) do
|
||||
for var y := Ceil(min) to Floor(max) do
|
||||
begin
|
||||
var p := RealToScreen(Pnt(x,y));
|
||||
dc.DrawEllipse(ColorBrush(Colors.Black),nil,p,sz,sz);
|
||||
end;
|
||||
end);
|
||||
|
||||
// Примитивы рисования в логических (реальных) координатах, необходимые Черепашке для рисования
|
||||
procedure LineToReal(x,y: real);
|
||||
begin
|
||||
LineTo(RealToScreenX(x),RealToScreenY(y));
|
||||
end;
|
||||
|
||||
procedure MoveToReal(x,y: real);
|
||||
begin
|
||||
MoveTo(RealToScreenX(x),RealToScreenY(y));
|
||||
end;
|
||||
|
||||
procedure CircleReal(r: real);
|
||||
begin
|
||||
var w := Pen.Width;
|
||||
Pen.Width := 1;
|
||||
GraphWPF.Circle(Pen.X,Pen.Y,Scale * r);
|
||||
Pen.Width := w;
|
||||
end;
|
||||
|
||||
procedure CircleRealColor(r: real; c: Color);
|
||||
begin
|
||||
var w := Pen.Width;
|
||||
Pen.Width := 1;
|
||||
GraphWPF.Circle(Pen.X,Pen.Y,Scale * r,c);
|
||||
Pen.Width := w;
|
||||
end;
|
||||
|
||||
procedure PointRealColor(x,y: real; c: Color) := FastDraw(dc ->
|
||||
begin
|
||||
var p := RealToScreen(Pnt(x,y));
|
||||
dc.DrawEllipse(ColorBrush(c),nil,p,PointRadius,PointRadius);
|
||||
end);
|
||||
|
||||
procedure PointsRealColor(points: array of Point; c: Color) := FastDraw(dc ->
|
||||
begin
|
||||
var cc := ColorBrush(c);
|
||||
foreach var p in points do
|
||||
begin
|
||||
var pp := RealToScreen(p);
|
||||
dc.DrawEllipse(cc,nil,pp,PointRadius,PointRadius);
|
||||
end;
|
||||
end);
|
||||
end;
|
||||
|
||||
{$endregion}
|
||||
|
||||
// Переменные для системы координат
|
||||
var
|
||||
Scale := 27.1;
|
||||
Origin := Pnt(0,0);
|
||||
|
||||
// Переменные для Черепашки
|
||||
var
|
||||
tp: Point; // текущая точка Черепахи (экранная, но сделаем её логической)
|
||||
angle: real; // Угол поворота Черепахи
|
||||
dr := False; // Опущен хвост Черепахи или нет
|
||||
|
||||
// Команды для "проигрывания" при перерисовке (изменении масштаба и сдвиге)
|
||||
Commands := new List<ICommand>;
|
||||
|
||||
// Система координат
|
||||
var fso: FS;
|
||||
procedure MoveToReal(x,y: real);
|
||||
begin
|
||||
MoveTo(fso.RealToScreenX(x),fso.RealToScreenY(y));
|
||||
end;
|
||||
|
||||
// Вспомогательные переменные для событий
|
||||
var
|
||||
StartPoint,MousePoint: Point;
|
||||
deltaMultScale := 1.2; // на сколько увеличивать-уменьшать при прокручивании колёсика мыши
|
||||
|
||||
// Вспомогательная переменная для задачи перерисовки
|
||||
var tsk: System.Threading.Tasks.Task := nil; // Задача для перерисовки. В каждый момент одна
|
||||
|
||||
|
||||
{$region Функции создания команд для "проигрывания"}
|
||||
|
||||
{type
|
||||
Command = record
|
||||
typ: CommandType;
|
||||
r,da,x,y: real;
|
||||
points: array of Point;
|
||||
color: GColor;
|
||||
end;}
|
||||
|
||||
{$region Команды Черепахи при "проигрывании"}
|
||||
|
||||
|
|
@ -306,7 +31,7 @@ begin
|
|||
tp += r * Vect(Cos(DegToRad(angle)),Sin(DegToRad(angle)));
|
||||
if dr then
|
||||
dc.DrawLine(CurrentPen,Pnt(Pen.X,Pen.Y),fso.RealToScreen(tp));
|
||||
fso.MoveToReal(tp.X,tp.Y)
|
||||
MoveToReal(tp.X,tp.Y)
|
||||
end;
|
||||
|
||||
procedure TurnPlay(da: real);
|
||||
|
|
@ -327,128 +52,91 @@ end;
|
|||
procedure ToPointPlay(x,y: real);
|
||||
begin
|
||||
tp := Pnt(x,y);
|
||||
fso.MoveToReal(tp.X,tp.Y);
|
||||
MoveToReal(tp.X,tp.Y);
|
||||
end;
|
||||
|
||||
procedure CirclePlay(dc: DrawingContext; r: real; color: GColor);
|
||||
procedure CirclePenPosPlay(dc: DrawingContext; r: real; color: GColor);
|
||||
begin
|
||||
dc.DrawEllipse(ColorBrush(color),ColorPen(Pen.Color,1),fso.RealToScreen(tp),r * Scale,r * Scale);
|
||||
end;
|
||||
|
||||
procedure PointPlay(dc: DrawingContext; x,y: real; color: GColor);
|
||||
begin
|
||||
dc.DrawEllipse(ColorBrush(color),nil,fso.RealToScreen(Pnt(x,y)),PointRadius,PointRadius);
|
||||
end;
|
||||
|
||||
procedure PointsPlay(dc: DrawingContext; points: array of Point; color: GColor);
|
||||
begin
|
||||
var cc := ColorBrush(color);
|
||||
foreach var p in points do
|
||||
begin
|
||||
var pp := fso.RealToScreen(p);
|
||||
dc.DrawEllipse(cc,nil,pp,PointRadius,PointRadius);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SetWidthPlay(r: real);
|
||||
begin
|
||||
CurrentPen := ColorPen(Pen.Color,r);
|
||||
CurrentPen := ColorPen(CurrentPenColor,r);
|
||||
end;
|
||||
|
||||
procedure SetColorPlay(c: GColor);
|
||||
begin
|
||||
CurrentPen := ColorPen(c,Pen.Width);
|
||||
CurrentPen := ColorPen(c,CurrentPen.Thickness);
|
||||
end;
|
||||
|
||||
{$endregion}
|
||||
|
||||
type
|
||||
ForwC = auto class(ICommand)
|
||||
ForwC = auto class(Command)
|
||||
r: real;
|
||||
public
|
||||
procedure Play(dc: DrawingContext);
|
||||
procedure Play(dc: DrawingContext); override;
|
||||
begin
|
||||
ForwPlay(dc,r);
|
||||
end;
|
||||
end;
|
||||
TurnC = auto class(ICommand)
|
||||
TurnC = auto class(Command)
|
||||
da: real;
|
||||
public
|
||||
procedure Play(dc: DrawingContext);
|
||||
procedure Play(dc: DrawingContext); override;
|
||||
begin
|
||||
TurnPlay(da)
|
||||
end;
|
||||
end;
|
||||
UpC = auto class(ICommand)
|
||||
UpC = auto class(Command)
|
||||
public
|
||||
procedure Play(dc: DrawingContext);
|
||||
procedure Play(dc: DrawingContext); override;
|
||||
begin
|
||||
UpPlay
|
||||
end;
|
||||
end;
|
||||
DownC = auto class(ICommand)
|
||||
DownC = auto class(Command)
|
||||
public
|
||||
procedure Play(dc: DrawingContext);
|
||||
procedure Play(dc: DrawingContext); override;
|
||||
begin
|
||||
DownPlay
|
||||
end;
|
||||
end;
|
||||
ToPointC = auto class(ICommand)
|
||||
ToPointC = auto class(Command)
|
||||
x,y: real;
|
||||
public
|
||||
procedure Play(dc: DrawingContext);
|
||||
procedure Play(dc: DrawingContext); override;
|
||||
begin
|
||||
ToPointPlay(x,y);
|
||||
end;
|
||||
end;
|
||||
CircleC = auto class(ICommand)
|
||||
CircleC = auto class(Command)
|
||||
r: real;
|
||||
c: Color;
|
||||
public
|
||||
procedure Play(dc: DrawingContext);
|
||||
procedure Play(dc: DrawingContext); override;
|
||||
begin
|
||||
CirclePlay(dc,r,c);
|
||||
CirclePenPosPlay(dc,r,c);
|
||||
end;
|
||||
end;
|
||||
PointC = auto class(ICommand)
|
||||
x,y: real;
|
||||
c: Color;
|
||||
public
|
||||
procedure Play(dc: DrawingContext);
|
||||
begin
|
||||
PointPlay(dc,x,y,c);
|
||||
end;
|
||||
end;
|
||||
PointsC = auto class(ICommand)
|
||||
points: array of Point;
|
||||
c: Color;
|
||||
public
|
||||
procedure Play(dc: DrawingContext);
|
||||
begin
|
||||
PointsPlay(dc,points,c);
|
||||
end;
|
||||
end;
|
||||
SetWidthC = auto class(ICommand)
|
||||
SetWidthC = auto class(Command)
|
||||
w: real;
|
||||
public
|
||||
procedure Play(dc: DrawingContext);
|
||||
procedure Play(dc: DrawingContext); override;
|
||||
begin
|
||||
SetWidthPlay(w);
|
||||
end;
|
||||
end;
|
||||
SetColorC = auto class(ICommand)
|
||||
SetColorC = auto class(Command)
|
||||
c: Color;
|
||||
public
|
||||
procedure Play(dc: DrawingContext);
|
||||
procedure Play(dc: DrawingContext); override;
|
||||
begin
|
||||
SetColorPlay(c);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure AddCommand(c: ICommand);
|
||||
begin
|
||||
Commands.Add(c);
|
||||
end;
|
||||
|
||||
|
||||
{$endregion}
|
||||
|
||||
|
|
@ -457,6 +145,24 @@ function Window := GraphWPF.Window;
|
|||
// fso - глобальная и всегда инициализированная!!!
|
||||
// tp - в логических (это точка Черепахи)
|
||||
|
||||
// Вспомогательные для Circle
|
||||
procedure CirclePenPosReal(r: real);
|
||||
begin
|
||||
var w := Pen.Width;
|
||||
Pen.Width := 1;
|
||||
GraphWPF.Circle(Pen.X,Pen.Y,fso.Scale * r);
|
||||
Pen.Width := w;
|
||||
end;
|
||||
|
||||
procedure CirclePenPosReal(r: real; c: Color);
|
||||
begin
|
||||
var w := Pen.Width;
|
||||
Pen.Width := 1;
|
||||
GraphWPF.Circle(Pen.X,Pen.Y,fso.Scale * r,c);
|
||||
Pen.Width := w;
|
||||
end;
|
||||
|
||||
|
||||
{$region Команды Черепахи}
|
||||
|
||||
/// Продвигает Черепаху вперёд на расстояние r
|
||||
|
|
@ -476,7 +182,7 @@ begin
|
|||
end
|
||||
);
|
||||
end;
|
||||
fso.MoveToReal(tp.X,tp.Y)
|
||||
MoveToReal(tp.X,tp.Y)
|
||||
end;
|
||||
|
||||
/// Продвигает Черепаху назад на расстояние r
|
||||
|
|
@ -514,70 +220,47 @@ procedure ToPoint(x,y: real);
|
|||
begin
|
||||
AddCommand(new ToPointC(x,y));
|
||||
tp := Pnt(x,y);
|
||||
fso.MoveToReal(tp.X,tp.Y);
|
||||
MoveToReal(tp.X,tp.Y);
|
||||
end;
|
||||
|
||||
// Это в Turtle добавление
|
||||
/// Рисует окружность указанного радиуса
|
||||
procedure Circle(r: real);
|
||||
begin
|
||||
fso.CircleReal(r);
|
||||
CirclePenPosReal(r);
|
||||
AddCommand(new CircleC(r,Colors.White));
|
||||
end;
|
||||
|
||||
/// Рисует окружность указанного радиуса и цвета
|
||||
procedure Circle(r: real; color: GColor);
|
||||
begin
|
||||
fso.CircleRealColor(r,color);
|
||||
CirclePenPosReal(r,color);
|
||||
AddCommand(new CircleC(r,color));
|
||||
end;
|
||||
|
||||
/// Рисует точку заданным цветом
|
||||
procedure DrawPoint(x,y: real; color: GColor := Colors.Black);
|
||||
begin
|
||||
fso.PointRealColor(x,y,color);
|
||||
AddCommand(new PointC(x,y,color));
|
||||
end;
|
||||
procedure DrawPoint(x,y: real; color: GColor := Colors.Black; PointRadius: real := 2) := Coords.DrawPoint(x,y,color,PointRadius);
|
||||
|
||||
/// Рисует точки заданным цветом
|
||||
procedure DrawPoints(points: array of Point; color: GColor);
|
||||
begin
|
||||
fso.PointsRealColor(points,color);
|
||||
AddCommand(new PointsC(points,color));
|
||||
end;
|
||||
procedure DrawPoints(points: array of Point; color: GColor; PointRadius: real := 2) := Coords.DrawPoints(points,color,PointRadius);
|
||||
|
||||
/// Рисует точки следующим цветом в палитре цветов
|
||||
procedure DrawPoints(points: array of Point);
|
||||
begin
|
||||
var color := Palette[PaletteIndex];
|
||||
PaletteIndex += 1;
|
||||
if PaletteIndex >= Palette.Length then
|
||||
PaletteIndex := 0;
|
||||
DrawPoints(points,color);
|
||||
end;
|
||||
procedure DrawPoints(points: array of Point; PointRadius: real := 2) := Coords.DrawPoints(points,PointRadius);
|
||||
|
||||
/// Рисует точки заданным цветом
|
||||
procedure DrawPoints(xx,yy: array of real; color: GColor);
|
||||
begin
|
||||
var points := Zip(xx,yy,(x,y) -> Pnt(x,y)).ToArray;
|
||||
DrawPoints(points,color);
|
||||
end;
|
||||
procedure DrawPoints(xx,yy: array of real; color: GColor; PointRadius: real := 2) := Coords.DrawPoints(xx,yy,color,PointRadius);
|
||||
|
||||
/// Рисует точки следующим цветом в палитре цветов
|
||||
procedure DrawPoints(xx,yy: array of real);
|
||||
begin
|
||||
var points := Zip(xx,yy,(x,y) -> Pnt(x,y)).ToArray;
|
||||
DrawPoints(points);
|
||||
end;
|
||||
procedure DrawPoints(xx,yy: array of real; PointRadius: real := 2) := Coords.DrawPoints(xx,yy,PointRadius);
|
||||
|
||||
|
||||
/// Устанавливает ширину линии
|
||||
/// Устанавливает ширину линии Черепахи
|
||||
procedure SetWidth(w: real);
|
||||
begin
|
||||
CurrentPen := ColorPen(Pen.Color,w);
|
||||
Pen.Width := w;
|
||||
end;
|
||||
|
||||
/// Устанавливает цвет линии
|
||||
/// Устанавливает цвет линии Черепахи
|
||||
procedure SetColor(c: GColor);
|
||||
begin
|
||||
CurrentPen := ColorPen(c,Pen.Width);
|
||||
|
|
@ -586,134 +269,28 @@ end;
|
|||
|
||||
{$endregion}
|
||||
|
||||
|
||||
/// Установка положения начала координат
|
||||
procedure SetOrigin(x,y: real);
|
||||
begin
|
||||
Origin := Pnt(x,y);
|
||||
Coords.SetOrigin(x,y);
|
||||
Up;
|
||||
ToPoint(x,y);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
var cansellation := False;
|
||||
|
||||
procedure PlayCommands;
|
||||
begin
|
||||
FastDraw(dc -> begin
|
||||
dc.PushClip(new System.Windows.Media.RectangleGeometry(Rect(fso.x,fso.y,fso.w,fso.h)));
|
||||
foreach var command in commands do
|
||||
command.Play(dc);
|
||||
dc.Pop;
|
||||
end);
|
||||
end;
|
||||
|
||||
procedure InitTurtle;
|
||||
begin
|
||||
tp := (0,0);
|
||||
angle := 90;
|
||||
fso.MoveToReal(tp.X,tp.Y);
|
||||
MoveToReal(tp.X,tp.Y);
|
||||
end;
|
||||
|
||||
var DrawCoords := 1;
|
||||
|
||||
procedure InitCoordinates;
|
||||
begin
|
||||
fso := new FS(Scale,0,0,Window.Width,Window.Height,Origin);
|
||||
if DrawCoords = 1 then
|
||||
fso.Draw
|
||||
else if DrawCoords = 2 then
|
||||
begin
|
||||
fso.Draw;
|
||||
fso.DrawPoints;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Redraw;
|
||||
begin
|
||||
if (tsk <> nil) and not tsk.IsCompleted then
|
||||
exit;
|
||||
tsk := Task.Run(() -> begin
|
||||
GraphWPF.Redraw(()->begin
|
||||
Window.Clear;
|
||||
InitCoordinates;
|
||||
InitTurtle;
|
||||
PlayCommands;
|
||||
end)
|
||||
end)
|
||||
end;
|
||||
|
||||
procedure MouseDown(x,y: real; mb: integer);
|
||||
begin
|
||||
StartPoint := Pnt(x,y);
|
||||
end;
|
||||
|
||||
var AfterResize := False;
|
||||
|
||||
procedure MouseMove(x,y: real; mb: integer);
|
||||
begin
|
||||
if AfterResize then
|
||||
begin
|
||||
AfterResize := False;
|
||||
exit;
|
||||
end;
|
||||
if (tsk<>nil) and not tsk.IsCompleted then
|
||||
exit;
|
||||
MousePoint := Pnt(x,y);
|
||||
if mb<>1 then
|
||||
exit;
|
||||
var v := fso.ScreenToReal(MousePoint) - fso.ScreenToReal(StartPoint);
|
||||
Origin.X -= v.X;
|
||||
Origin.Y -= v.Y;
|
||||
StartPoint := MousePoint;
|
||||
Redraw;
|
||||
end;
|
||||
|
||||
|
||||
procedure MouseWheel(delta: real);
|
||||
begin
|
||||
if (tsk<>nil) and not tsk.IsCompleted then
|
||||
exit;
|
||||
|
||||
if delta > 0 then // вверх - увеличение
|
||||
begin
|
||||
if MinLen/Scale > 0.0001 then
|
||||
Scale *= deltaMultScale
|
||||
else exit;
|
||||
Origin := Origin + (deltaMultScale - 1)/deltaMultScale * (fso.ScreenToReal(mousePoint) - Origin);
|
||||
end
|
||||
else
|
||||
begin
|
||||
if MinLen/Scale < 500 then
|
||||
Scale /= deltaMultScale
|
||||
else exit;
|
||||
Origin := Origin - (deltaMultScale - 1) * (fso.ScreenToReal(mousePoint) - Origin);
|
||||
end;
|
||||
Redraw;
|
||||
end;
|
||||
|
||||
procedure SetScale(sc: real);
|
||||
begin
|
||||
Scale := sc;
|
||||
Window.Clear;
|
||||
InitCoordinates;
|
||||
InitTurtle;
|
||||
end;
|
||||
|
||||
|
||||
procedure Init;
|
||||
procedure InitOnce; // Это тоже относится к Черепахе
|
||||
begin
|
||||
Window.Title := 'Исполнитель Черепаха';
|
||||
Font.Size := 12;
|
||||
Pen.RoundCap := True;
|
||||
end;
|
||||
|
||||
procedure Resize;
|
||||
begin
|
||||
Redraw;
|
||||
AfterResize := True;
|
||||
end;
|
||||
|
||||
procedure KeyDown(k: Key);
|
||||
begin
|
||||
case k of
|
||||
|
|
@ -728,14 +305,9 @@ begin
|
|||
end;
|
||||
|
||||
initialization
|
||||
Init;
|
||||
InitCoordinates;
|
||||
InitProc := InitTurtle;
|
||||
InitTurtle;
|
||||
InitOnce;
|
||||
finalization
|
||||
Redraw;
|
||||
OnMouseWheel := MouseWheel;
|
||||
OnMouseDown := MouseDown;
|
||||
OnMouseMove := MouseMove;
|
||||
OnResize := Resize;
|
||||
OnKeyDown := KeyDown;
|
||||
end.
|
||||
|
|
@ -624,12 +624,12 @@ namespace PascalABCCompiler.TreeConverter
|
|||
}
|
||||
|
||||
/*->*/
|
||||
public class AutoClassMustNotHaveParents : CompilationErrorWithLocation
|
||||
public class AutoClassMustNotHaveParentsWithFields : CompilationErrorWithLocation
|
||||
{
|
||||
public AutoClassMustNotHaveParents(location loc) : base(loc) { }
|
||||
public AutoClassMustNotHaveParentsWithFields(location loc) : base(loc) { }
|
||||
public override string ToString()
|
||||
{
|
||||
return string.Format(StringResources.Get("AUTO_CLASS_MUST_NOT_HAVE_PARENTS"));
|
||||
return string.Format(StringResources.Get("AUTO_CLASS_MUST_NOT_HAVE_PARENTS_WITH_FIELDS"));
|
||||
}
|
||||
}
|
||||
/*->*/
|
||||
|
|
|
|||
|
|
@ -4013,8 +4013,15 @@ namespace PascalABCCompiler.TreeConverter
|
|||
{
|
||||
var ff = convert_strong(c);
|
||||
if (!ff.IsInterface)
|
||||
AddError(new AutoClassMustNotHaveParents(get_location(_class_definition)));
|
||||
|
||||
{
|
||||
if (ff is common_type_node ctn)
|
||||
{
|
||||
// разрешить также наследовать автоклассы от классов без полей
|
||||
if (ctn.fields.Count == 0)
|
||||
continue;
|
||||
}
|
||||
AddError(new AutoClassMustNotHaveParentsWithFields(get_location(_class_definition)));
|
||||
}
|
||||
}
|
||||
|
||||
List<SyntaxTree.ident> names = new List<SyntaxTree.ident>();
|
||||
|
|
|
|||
635
bin/Lib/Coords.pas
Normal file
635
bin/Lib/Coords.pas
Normal file
|
|
@ -0,0 +1,635 @@
|
|||
/// Координатная сетка с возможностью масштабирования мышью
|
||||
unit Coords;
|
||||
|
||||
uses GraphWPFBase;
|
||||
uses GraphWPF;
|
||||
uses System.Threading.Tasks;
|
||||
|
||||
type
|
||||
Colors = GraphWPF.Colors;
|
||||
Point = System.Windows.Point;
|
||||
Alignment = GraphWPF.Alignment;
|
||||
Command = class
|
||||
procedure Play(dc: DrawingContext); abstract;
|
||||
function AddToListAndPlay: Command;
|
||||
end;
|
||||
TypeFace = System.Windows.Media.Typeface;
|
||||
FormattedText = System.Windows.Media.FormattedText;
|
||||
|
||||
var
|
||||
// Команды для "проигрывания" при перерисовке (изменении масштаба и сдвиге)
|
||||
Commands := new List<Command>;
|
||||
|
||||
function Command.AddToListAndPlay: Command;
|
||||
begin
|
||||
Commands.Add(Self);
|
||||
FastDraw(dc -> Self.Play(dc));
|
||||
Result := Self;
|
||||
end;
|
||||
|
||||
var
|
||||
CurrentPen := ColorPen(Colors.Black,1.4);
|
||||
|
||||
CurrentFontFace := new Typeface('Arial');
|
||||
|
||||
Palette: array of Color := Arr(Colors.Green, Colors.Blue, Colors.Red, Colors.Orange,
|
||||
Colors.Magenta, Colors.LightGreen, Colors.LightBlue, Colors.Coral, Colors.Gray, Colors.LightGray);
|
||||
PaletteIndex := 0;
|
||||
|
||||
function Pnt(x,y: real): Point := GraphWPF.Pnt(x,y);
|
||||
|
||||
function CurrentPenColor: Color
|
||||
:= (CurrentPen.Brush as System.Windows.Media.SolidColorBrush).Color;
|
||||
|
||||
function CurrentPenWidth: real := CurrentPen.Thickness;
|
||||
|
||||
{$region Класс координатной сетки FS}
|
||||
|
||||
var MinLen := 25;
|
||||
|
||||
// Сделаем в логических координатах fso.LineToReal, fso.MoveToReal, fso.CircleReal
|
||||
type
|
||||
FS = class
|
||||
// origin - точка по центру графика в логических координатах
|
||||
origin: Point;
|
||||
// scale - количество пикселей на одну единицу
|
||||
scale: real;
|
||||
mx, my: real;
|
||||
a, b, min, max: real; // реальные координаты [a.b] x [min,max]
|
||||
x, y, w, h: real; // экранные координаты - левый верхний угол, ширина и высота
|
||||
// XTicks, YTicks - сколько логических единиц занимает одно деление (по умолчанию 1)
|
||||
XTicks, YTicks: real;
|
||||
// XTicks = YTicks = FindP(Scale)/Scale
|
||||
// Ticks будет меняться по стратегии: 0.1 0.2 0.5 1 2 5 10
|
||||
MarginY := 6;
|
||||
MarginX := 6;
|
||||
XTicksPrecision := 4;
|
||||
YTicksPrecision := 5;
|
||||
spaceBetweenTextAndGraph := 0;
|
||||
|
||||
constructor (scale, x, y, w, h: real; origin: Point := Pnt(0,0));
|
||||
begin
|
||||
Self.Scale := scale;
|
||||
Self.x := x; Self.y := y; Self.w := w; Self.h := h;
|
||||
Self.origin := origin;
|
||||
CorrectBounds;
|
||||
end;
|
||||
|
||||
function PointInside(p: Point): boolean;
|
||||
begin
|
||||
Result := (p.X >= a) and (p.X <= b) and (p.Y >= min) and (p.Y <= max);
|
||||
end;
|
||||
|
||||
function FindP(Scale: real): real;
|
||||
begin // MinLen = 25 - то самое число
|
||||
var p := Scale;
|
||||
if p < MinLen then
|
||||
while p < MinLen do
|
||||
p *= 10
|
||||
else begin
|
||||
while p >= MinLen * 10 do
|
||||
p /= 10;
|
||||
end;
|
||||
// p in [MinLen..MinLen * 10)
|
||||
if p >= MinLen * 5 then
|
||||
p /= 5
|
||||
else if p >= MinLen *2 then
|
||||
p /= 2;
|
||||
Result := p;
|
||||
end;
|
||||
|
||||
procedure CorrectBounds;
|
||||
begin
|
||||
mx := Scale;
|
||||
my := Scale;
|
||||
a := -w/2/mx;
|
||||
b := -a;
|
||||
max := h/2/my;
|
||||
min := - max;
|
||||
|
||||
XTicks := FindP(Scale)/Scale;
|
||||
YTicks := XTicks;
|
||||
|
||||
var th := TextHeightP('0'); // высота текста
|
||||
// tw - ширина текста - максимум по всем числам
|
||||
var RY0 := GetRY0; // самое маленькое логическое значение по y. Соответствует нижней части экрана
|
||||
var tw := RY0.Step(YTicks).TakeWhile(ry -> ry <= max + origin.y)
|
||||
.Select(y -> TextWidthP(y.Round(YTicksPrecision).ToString)).DefaultIfEmpty.Max;
|
||||
if tw = 0 then
|
||||
tw := TextWidthP('0');
|
||||
var dd := TextWidthP(b.Round(xTicksPrecision).ToString)/2;
|
||||
// dd - это половинка ширины последней цифры
|
||||
//var tw := TextWidth('-99.9');
|
||||
w -= {MarginX * 2 +} spaceBetweenTextAndGraph + tw + dd;
|
||||
h -= MarginY * 2 + spaceBetweenTextAndGraph + th;
|
||||
x += MarginX + spaceBetweenTextAndGraph + tw;
|
||||
y += MarginY;
|
||||
|
||||
// И ещё раз пересчитаем!
|
||||
a := -w/2/mx;
|
||||
b := -a;
|
||||
max := h/2/my;
|
||||
min := - max;
|
||||
|
||||
XTicks := FindP(Scale)/Scale;
|
||||
YTicks := XTicks;
|
||||
end;
|
||||
|
||||
// a,b,min,max - логические
|
||||
function RealToScreenX(xx: real) := x + mx * (xx - origin.x - a);
|
||||
function RealToScreenY(yy: real) := y + h - my * (yy - origin.y - min); // ?
|
||||
function ScreenToRealX(xx: real) := (xx - x) / mx + a + origin.x;
|
||||
function ScreenToRealY(yy: real) := (y + h - yy) / my + min + origin.y;
|
||||
function ScreenToReal(p: Point): Point := Pnt(ScreenToRealX(p.X),ScreenToRealY(p.Y));
|
||||
function RealToScreen(p: Point): Point := Pnt(RealToScreenX(p.X),RealToScreenY(p.Y));
|
||||
|
||||
/// Самое маленькое логическое значение по x
|
||||
function GetRX0: real;
|
||||
begin
|
||||
var xt := XTicks * Trunc(Abs(a + origin.x)/XTicks);
|
||||
var rx0: real;
|
||||
if a + origin.x <= 0 then
|
||||
rx0 := -xt
|
||||
else rx0 := xt + XTicks;
|
||||
Result := rx0;
|
||||
end;
|
||||
|
||||
/// Самое маленькое логическое значение по y
|
||||
function GetRY0: real;
|
||||
begin
|
||||
var yt: real := YTicks * Trunc(Abs(min + origin.y)/YTicks);
|
||||
var ry0: real;
|
||||
if min + origin.y <= 0 then
|
||||
ry0 := -yt
|
||||
else ry0 := yt + YTicks;
|
||||
Result := ry0;
|
||||
end;
|
||||
|
||||
procedure DrawDC(dc: DrawingContext);
|
||||
begin
|
||||
var AxisColor := GrayColor(112);
|
||||
var GridPen := ColorPen(Colors.LightGray,1);
|
||||
var AxisPen := ColorPen(AxisColor,1);
|
||||
|
||||
var stepx := mx * XTicks; // Экранный шаг по оси x
|
||||
var rx0 := GetRX0; // реальная начальная координата по x. При запуске = 14
|
||||
var x0 := RealToScreenX(rx0); // Экранная начальная координата по x.
|
||||
|
||||
// ширина надписи по оси ox
|
||||
var www := PABCSystem.max(TextWidthP(rx0.Round(XTicksPrecision).ToString),
|
||||
TextWidthP((rx0+XTicks).Round(XTicksPrecision).ToString)) + 3;
|
||||
var numTicks := Trunc(w / 2 / stepx);
|
||||
|
||||
var it := 0;
|
||||
if numTicks.IsEven then
|
||||
it += 1;
|
||||
|
||||
while x0<=x+w+0.000001 do
|
||||
begin
|
||||
if Abs(rx0)<0.000001 then
|
||||
dc.DrawLine(AxisPen,Pnt(x0,y),Pnt(x0,y+h))
|
||||
else dc.DrawLine(GridPen,Pnt(x0,y),Pnt(x0,y+h));
|
||||
var text := rx0.Round(XTicksPrecision).ToString;
|
||||
if (www <= stepx) or (it mod 2 = 1) then
|
||||
TextOutDC(dc,x0,y+h+4,text,Alignment.CenterTop);
|
||||
x0 += stepx;
|
||||
rx0 += XTicks;
|
||||
it += 1;
|
||||
end;
|
||||
|
||||
var stepy := my * YTicks;
|
||||
var ry0 := GetRY0;
|
||||
var y0 := RealToScreenY(ry0);
|
||||
|
||||
while y0>=y-0.000001 do
|
||||
begin
|
||||
if Abs(ry0)<0.000001 then
|
||||
DrawLineDC(dc,x,y0,x+w,y0,AxisPen)
|
||||
else DrawLineDC(dc,x,y0,x+w,y0,GridPen);
|
||||
TextOutDC(dc,x-4,y0,ry0.Round(YTicksPrecision).ToString,Alignment.RightCenter);
|
||||
y0 -= stepy;
|
||||
ry0 += YTicks;
|
||||
end;
|
||||
|
||||
DrawRectangleDC(dc, x, y, w, h, nil, ColorPen(Colors.Black,1));
|
||||
end;
|
||||
|
||||
// Рисование координат
|
||||
procedure Draw := FastDraw(DrawDC);
|
||||
|
||||
// Рисование точек в целочисленных координатах. Специфический метод системы координат
|
||||
procedure DrawPoints := FastDraw(dc -> begin
|
||||
var sz := 1.2;
|
||||
if Scale < 10 then
|
||||
exit;
|
||||
var a := ScreenToRealX(x); var b := ScreenToRealX(x+w);
|
||||
var min := ScreenToRealY(y+h); var max := ScreenToRealY(y);
|
||||
for var x := Ceil(a) to Floor(b) do
|
||||
for var y := Ceil(min) to Floor(max) do
|
||||
begin
|
||||
var p := RealToScreen(Pnt(x,y));
|
||||
dc.DrawEllipse(ColorBrush(Colors.Black),nil,p,sz,sz);
|
||||
end;
|
||||
end);
|
||||
end;
|
||||
|
||||
const Scale0 = 27.1;
|
||||
|
||||
{$endregion}
|
||||
|
||||
// Переменные для системы координат
|
||||
var
|
||||
Scale := Scale0;
|
||||
Origin := Pnt(0,0);
|
||||
|
||||
var
|
||||
// Система координат
|
||||
fso: FS;
|
||||
|
||||
// Вспомогательная переменная для задачи перерисовки
|
||||
var tsk: System.Threading.Tasks.Task := nil; // Задача для перерисовки. В каждый момент одна
|
||||
|
||||
var RusCultureInfo := new System.Globalization.CultureInfo('ru-ru');
|
||||
|
||||
function FormText(text: string; size: real := 14; color: GColor := Colors.Black): FormattedText :=
|
||||
new FormattedText(text, RusCultureInfo, System.Windows.FlowDirection.LeftToRight,
|
||||
CurrentFontFace, size, Brushes.Black);
|
||||
|
||||
function FormTextWithName(text: string; FontName: string := 'Arial'; size: real := 14; color: GColor := Colors.Black): FormattedText :=
|
||||
new FormattedText(text, RusCultureInfo, System.Windows.FlowDirection.LeftToRight,
|
||||
new Typeface(FontName), size, Brushes.Black);
|
||||
|
||||
{$region Команды при "проигрывании"}
|
||||
var PointRadius := 2.0;
|
||||
|
||||
var x := FormText('sdfgh');
|
||||
|
||||
procedure PointPlay(dc: DrawingContext; x,y: real; c: GColor; PointRadius: real);
|
||||
begin
|
||||
var p := fso.RealToScreen(Pnt(x,y));
|
||||
dc.DrawEllipse(ColorBrush(c),nil,p,PointRadius,PointRadius);
|
||||
end;
|
||||
|
||||
procedure PointsPlay(dc: DrawingContext; points: array of Point; c: GColor; PointRadius: real);
|
||||
begin
|
||||
var cc := ColorBrush(c);
|
||||
foreach var p in points do
|
||||
begin
|
||||
var pp := fso.RealToScreen(p);
|
||||
dc.DrawEllipse(cc,nil,pp,PointRadius,PointRadius);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure LineToPlay(dc: DrawingContext; x,y: real);
|
||||
begin
|
||||
var p := fso.RealToScreen(Pnt(x,y));
|
||||
dc.DrawLine(CurrentPen,Pnt(Pen.X,Pen.Y),p);
|
||||
GraphWPF.MoveTo(p.X,p.Y);
|
||||
end;
|
||||
|
||||
procedure CirclePlay(dc: DrawingContext; x,y,r: real; c: Color; borderc: Color);
|
||||
begin
|
||||
var cb := ColorBrush(c);
|
||||
var cp := ColorPen(borderc,CurrentPenWidth);
|
||||
var p := fso.RealToScreen(Pnt(x,y));
|
||||
r := r * Scale;
|
||||
dc.DrawEllipse(cb,cp,p,r,r);
|
||||
end;
|
||||
|
||||
procedure RectanglePlay(dc: DrawingContext; x,y,w,h: real; c: Color; borderc: Color);
|
||||
begin
|
||||
var cb := ColorBrush(c);
|
||||
var cp := ColorPen(borderc,CurrentPenWidth);
|
||||
var p := fso.RealToScreen(Pnt(x,y));
|
||||
w := w * Scale;
|
||||
h := h * Scale;
|
||||
dc.DrawRectangle(cb,cp,Rect(p.x,p.y,w,h));
|
||||
end;
|
||||
|
||||
procedure CorrectXYForTextHelper(var p: Point; w,h: real; Align: Alignment);
|
||||
begin
|
||||
case Align of
|
||||
Alignment.LeftTop: {ничего};
|
||||
Alignment.LeftCenter: p.y -= h/2;
|
||||
Alignment.LeftBottom: p.y -= h;
|
||||
Alignment.CenterTop: begin p.x -= w/2 end;
|
||||
Alignment.Center: begin p.x -= w/2; p.y -= h/2 end;
|
||||
Alignment.CenterBottom: begin p.x -= w/2; p.y -= h end;
|
||||
Alignment.RightTop: begin p.x -= w; end;
|
||||
Alignment.RightCenter: begin p.x -= w; p.y -= h/2 end;
|
||||
Alignment.RightBottom: begin p.x -= w; p.y -= h end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TextPlayUnscaled(dc: DrawingContext; x,y: real; text: string; size: real; color: GColor;
|
||||
Align: Alignment := Alignment.LeftTop);
|
||||
begin
|
||||
if size > 30000 then
|
||||
size := 30000;
|
||||
var p := fso.RealToScreen(Pnt(x,y));
|
||||
var ft := FormText(text,size,color);
|
||||
var (w,h) := (ft.Width,ft.Height);
|
||||
CorrectXYForTextHelper(p,w,h,Align);
|
||||
dc.DrawText(ft,p);
|
||||
end;
|
||||
|
||||
procedure TextFontNamePlayUnscaled(dc: DrawingContext; x,y: real; text,fontname: string; size: real; color: GColor;
|
||||
Align: Alignment := Alignment.LeftTop);
|
||||
begin
|
||||
if size > 30000 then
|
||||
size := 30000;
|
||||
var p := fso.RealToScreen(Pnt(x,y));
|
||||
var ft := FormTextWithName(text,fontname,size,color);
|
||||
var (w,h) := (ft.Width,ft.Height);
|
||||
CorrectXYForTextHelper(p,w,h,Align);
|
||||
dc.DrawText(ft,p);
|
||||
end;
|
||||
|
||||
procedure TextPlay(dc: DrawingContext; x,y: real; text: string; size: real; color: GColor;
|
||||
Align: Alignment := Alignment.LeftTop)
|
||||
:= TextPlayUnscaled(dc,x,y,text,size*Scale/Scale0,color,Align);
|
||||
|
||||
procedure TextFontNamePlay(dc: DrawingContext; x,y: real; text,fontname: string; size: real; color: GColor;
|
||||
Align: Alignment := Alignment.LeftTop)
|
||||
:= TextFontNamePlayUnscaled(dc,x,y,text,fontname,size*Scale/Scale0,color,Align);
|
||||
|
||||
{$endregion}
|
||||
|
||||
|
||||
type
|
||||
PointC = auto class(Command)
|
||||
x,y: real;
|
||||
c: Color;
|
||||
pointradius: real;
|
||||
public
|
||||
procedure Play(dc: DrawingContext); override := PointPlay(dc,x,y,c,pointradius);
|
||||
end;
|
||||
PointsC = auto class(Command)
|
||||
points: array of Point;
|
||||
c: Color;
|
||||
pointradius: real;
|
||||
public
|
||||
procedure Play(dc: DrawingContext); override := PointsPlay(dc,points,c,pointradius);
|
||||
end;
|
||||
CircleC = auto class(Command)
|
||||
x,y,r: real;
|
||||
c,borderc: Color;
|
||||
public
|
||||
procedure Play(dc: DrawingContext); override := CirclePlay(dc,x,y,r,c,borderc);
|
||||
end;
|
||||
RectangleC = auto class(Command)
|
||||
x,y,w,h: real;
|
||||
c,borderc: Color;
|
||||
public
|
||||
procedure Play(dc: DrawingContext); override := RectanglePlay(dc,x,y,w,h,c,borderc);
|
||||
end;
|
||||
TextC = auto class(Command)
|
||||
x,y: real;
|
||||
text: string;
|
||||
size: real;
|
||||
c: Color;
|
||||
Align: Alignment;
|
||||
public
|
||||
procedure Play(dc: DrawingContext); override := TextPlay(dc,x,y,text,size,c,Align);
|
||||
end;
|
||||
TextFontNameC = auto class(Command)
|
||||
x,y: real;
|
||||
text: string;
|
||||
size: real;
|
||||
c: Color;
|
||||
fontname: string;
|
||||
Align: Alignment;
|
||||
public
|
||||
procedure Play(dc: DrawingContext); override := TextFontNamePlay(dc,x,y,text,fontname,size,c,Align);
|
||||
end;
|
||||
TextUnscaledC = auto class(Command)
|
||||
x,y: real;
|
||||
text: string;
|
||||
size: real;
|
||||
c: Color;
|
||||
Align: Alignment;
|
||||
public
|
||||
procedure Play(dc: DrawingContext); override := TextPlayUnscaled(dc,x,y,text,size,c,Align);
|
||||
end;
|
||||
TextFontNameUnscaledC = auto class(Command)
|
||||
x,y: real;
|
||||
text: string;
|
||||
size: real;
|
||||
c: Color;
|
||||
fontname: string;
|
||||
Align: Alignment;
|
||||
public
|
||||
procedure Play(dc: DrawingContext); override := TextFontNamePlayUnscaled(dc,x,y,text,fontname,size,c,Align);
|
||||
end;
|
||||
|
||||
procedure AddCommand(c: Command);
|
||||
begin
|
||||
Commands.Add(c);
|
||||
end;
|
||||
|
||||
{$endregion}
|
||||
|
||||
function Window := GraphWPF.Window;
|
||||
|
||||
// fso - глобальная и всегда инициализированная!!!
|
||||
// tp - в логических (это точка Черепахи)
|
||||
|
||||
{$region Примитивы рисования, вносимые в список команд}
|
||||
|
||||
/// Рисует точку заданным цветом
|
||||
procedure DrawPoint(x,y: real; Color: GColor := Colors.Black; PointRadius: real := 2)
|
||||
:= PointC.Create(x,y,color,PointRadius).AddToListAndPlay;
|
||||
|
||||
/// Рисует прямоугольник
|
||||
procedure DrawRectangle(x,y,w,h: real; color: GColor := Colors.White; borderColor: GColor := Colors.Black)
|
||||
:= RectangleC.Create(x,y,w,h,color,borderColor).AddToListAndPlay;
|
||||
|
||||
/// Рисует прямоугольник без границы
|
||||
procedure FillRectangle(x,y,w,h: real; color: GColor := Colors.White)
|
||||
:= RectangleC.Create(x,y,w,h,color,Colors.Transparent).AddToListAndPlay;
|
||||
|
||||
/// Рисует круг
|
||||
procedure DrawCircle(x,y,r: real; color: GColor := Colors.White; borderColor: GColor := Colors.Black)
|
||||
:= CircleC.Create(x,y,r,color,borderColor).AddToListAndPlay;
|
||||
|
||||
/// Рисует круг без границы
|
||||
procedure FillCircle(x,y,r: real; color: GColor := Colors.White)
|
||||
:= CircleC.Create(x,y,r,color,Colors.Transparent).AddToListAndPlay;
|
||||
|
||||
/// Выводит текст в заданную позицию
|
||||
procedure DrawText(x,y: real; text: string; Size: real := 14; Color: GColor := Colors.Black; FontName: string := nil;
|
||||
Align: Alignment := Alignment.LeftTop);
|
||||
begin
|
||||
if FontName = nil then
|
||||
TextC.Create(x,y,text,Size,Color,Align).AddToListAndPlay
|
||||
else TextFontNameC.Create(x,y,text,Size,Color,fontname,Align).AddToListAndPlay;
|
||||
end;
|
||||
|
||||
/// Выводит текст в заданную позицию
|
||||
procedure DrawTextUnscaled(x,y: real; text: string; Size: real := 14; Color: GColor := Colors.Black; FontName: string := nil;
|
||||
Align: Alignment := Alignment.LeftTop);
|
||||
begin
|
||||
if FontName = nil then
|
||||
TextUnscaledC.Create(x,y,text,Size,Color,Align).AddToListAndPlay
|
||||
else TextFontNameUnscaledC.Create(x,y,text,Size,Color,fontname,Align).AddToListAndPlay;
|
||||
end;
|
||||
|
||||
/// Рисует точки заданным цветом
|
||||
procedure DrawPoints(points: array of Point; color: GColor; PointRadius: real := 2)
|
||||
:= PointsC.Create(points,color,PointRadius).AddToListAndPlay;
|
||||
|
||||
/// Рисует точки следующим цветом в палитре цветов
|
||||
procedure DrawPoints(points: array of Point; PointRadius: real := 2);
|
||||
begin
|
||||
var color := Palette[PaletteIndex];
|
||||
PaletteIndex += 1;
|
||||
if PaletteIndex >= Palette.Length then
|
||||
PaletteIndex := 0;
|
||||
DrawPoints(points,color,PointRadius);
|
||||
end;
|
||||
|
||||
/// Рисует точки заданным цветом
|
||||
procedure DrawPoints(xx,yy: array of real; color: GColor; PointRadius: real := 2);
|
||||
begin
|
||||
var points := Zip(xx,yy,(x,y) -> Pnt(x,y)).ToArray;
|
||||
DrawPoints(points,color,PointRadius);
|
||||
end;
|
||||
|
||||
/// Рисует точки следующим цветом в палитре цветов
|
||||
procedure DrawPoints(xx,yy: array of real; PointRadius: real := 2);
|
||||
begin
|
||||
var points := Zip(xx,yy,(x,y) -> Pnt(x,y)).ToArray;
|
||||
DrawPoints(points,PointRadius);
|
||||
end;
|
||||
|
||||
{$endregion}
|
||||
|
||||
procedure PlayCommands;
|
||||
begin
|
||||
FastDraw(dc -> begin
|
||||
dc.PushClip(new System.Windows.Media.RectangleGeometry(Rect(fso.x,fso.y,fso.w,fso.h)));
|
||||
foreach var command in commands do
|
||||
command.Play(dc);
|
||||
dc.Pop;
|
||||
end);
|
||||
end;
|
||||
|
||||
var DrawCoords := 1;
|
||||
|
||||
procedure InitCoordGrid;
|
||||
begin
|
||||
fso := new FS(Scale,0,0,Window.Width,Window.Height,Origin);
|
||||
if DrawCoords = 1 then
|
||||
fso.Draw
|
||||
else if DrawCoords = 2 then
|
||||
begin
|
||||
fso.Draw;
|
||||
fso.DrawPoints;
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
// Процедура дополнительной инициализации для модулей на основе Coords
|
||||
InitProc: procedure := nil;
|
||||
|
||||
/// Установка положения начала координат
|
||||
procedure SetOrigin(x,y: real);
|
||||
begin
|
||||
Origin := Pnt(x,y);
|
||||
end;
|
||||
|
||||
/// Установка масштаба
|
||||
procedure SetScale(sc: real);
|
||||
begin
|
||||
Scale := sc;
|
||||
Window.Clear;
|
||||
InitCoordGrid;
|
||||
if InitProc <> nil then
|
||||
InitProc;
|
||||
end;
|
||||
|
||||
procedure Redraw;
|
||||
begin
|
||||
if (tsk <> nil) and not tsk.IsCompleted then
|
||||
exit;
|
||||
tsk := Task.Run(() -> begin
|
||||
GraphWPF.Redraw(()->begin
|
||||
Window.Clear;
|
||||
InitCoordGrid;
|
||||
if InitProc <> nil then
|
||||
InitProc;
|
||||
PlayCommands;
|
||||
end)
|
||||
end)
|
||||
end;
|
||||
|
||||
type
|
||||
Handlers = static class
|
||||
// Вспомогательные переменные для событий
|
||||
static StartPoint,MousePoint: Point;
|
||||
static deltaMultScale := 1.2; // на сколько увеличивать-уменьшать при прокручивании колёсика мыши
|
||||
static AfterResize := False;
|
||||
|
||||
static procedure MouseDown(x,y: real; mb: integer);
|
||||
begin
|
||||
StartPoint := Pnt(x,y);
|
||||
end;
|
||||
|
||||
static procedure MouseMove(x,y: real; mb: integer);
|
||||
begin
|
||||
if AfterResize then
|
||||
begin
|
||||
AfterResize := False;
|
||||
exit;
|
||||
end;
|
||||
if (tsk<>nil) and not tsk.IsCompleted then
|
||||
exit;
|
||||
MousePoint := Pnt(x,y);
|
||||
if mb<>1 then
|
||||
exit;
|
||||
var v := fso.ScreenToReal(MousePoint) - fso.ScreenToReal(StartPoint);
|
||||
Origin.X -= v.X;
|
||||
Origin.Y -= v.Y;
|
||||
StartPoint := MousePoint;
|
||||
Redraw;
|
||||
end;
|
||||
|
||||
static procedure MouseWheel(delta: real);
|
||||
begin
|
||||
if (tsk<>nil) and not tsk.IsCompleted then
|
||||
exit;
|
||||
|
||||
if delta > 0 then // вверх - увеличение
|
||||
begin
|
||||
if MinLen/Scale > 0.0001 then
|
||||
Scale *= deltaMultScale
|
||||
else exit;
|
||||
Origin := Origin + (deltaMultScale - 1)/deltaMultScale * (fso.ScreenToReal(mousePoint) - Origin);
|
||||
end
|
||||
else
|
||||
begin
|
||||
if MinLen/Scale < 500 then
|
||||
Scale /= deltaMultScale
|
||||
else exit;
|
||||
Origin := Origin - (deltaMultScale - 1) * (fso.ScreenToReal(mousePoint) - Origin);
|
||||
end;
|
||||
Redraw;
|
||||
end;
|
||||
|
||||
static procedure Resize;
|
||||
begin
|
||||
Redraw;
|
||||
AfterResize := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
InitCoordGrid;
|
||||
Window.Title := 'Система координат';
|
||||
finalization
|
||||
Redraw;
|
||||
OnMouseWheel := Handlers.MouseWheel;
|
||||
OnMouseDown := Handlers.MouseDown;
|
||||
OnMouseMove := Handlers.MouseMove;
|
||||
OnResize := Handlers.Resize;
|
||||
end.
|
||||
|
|
@ -4,297 +4,22 @@ unit Turtle;
|
|||
uses GraphWPFBase;
|
||||
uses GraphWPF;
|
||||
uses System.Threading.Tasks;
|
||||
uses Coords;
|
||||
|
||||
type
|
||||
Colors = GraphWPF.Colors;
|
||||
CommandType = (ForwComm,TurnComm,CircleComm,PointComm,PointsComm,UpComm,DownComm,ToPointComm,SetColorComm,SetWidthComm);
|
||||
ICommand = interface
|
||||
procedure Play(dc: DrawingContext);
|
||||
end;
|
||||
{ Command = record
|
||||
typ: CommandType;
|
||||
r,da,x,y: real;
|
||||
points: array of Point;
|
||||
color: GColor;
|
||||
end;
|
||||
}
|
||||
var
|
||||
CurrentPen := ColorPen(Colors.Black,1.4);
|
||||
Palette: array of Color := Arr(Colors.Green, Colors.Blue, Colors.Red, Colors.Orange,
|
||||
Colors.Magenta, Colors.LightGreen, Colors.LightBlue, Colors.Coral, Colors.Gray, Colors.LightGray);
|
||||
PaletteIndex := 0;
|
||||
|
||||
function Pnt(x,y: real): Point := GraphWPF.Pnt(x,y);
|
||||
|
||||
{$region Класс координатной сетки FS}
|
||||
|
||||
var MinLen := 25;
|
||||
var PointRadius := 2.0;
|
||||
|
||||
// Сделаем в логических координатах fso.LineToReal, fso.MoveToReal, fso.CircleReal
|
||||
type
|
||||
FS = class
|
||||
// origin - точка по центру графика в логических координатах
|
||||
origin: Point;
|
||||
// scale - количество пикселей на одну единицу
|
||||
scale: real;
|
||||
mx, my: real;
|
||||
a, b, min, max: real; // реальные координаты [a.b] x [min,max]
|
||||
x, y, w, h: real; // экранные координаты - левый верхний угол, ширина и высота
|
||||
// XTicks, YTicks - сколько логических единиц занимает одно деление (по умолчанию 1)
|
||||
XTicks, YTicks: real;
|
||||
// XTicks = YTicks = FindP(Scale)/Scale
|
||||
// Ticks будет меняться по стратегии: 0.1 0.2 0.5 1 2 5 10
|
||||
MarginY := 6;
|
||||
MarginX := 6;
|
||||
XTicksPrecision := 4;
|
||||
YTicksPrecision := 5;
|
||||
spaceBetweenTextAndGraph := 0;
|
||||
|
||||
constructor (scale, x, y, w, h: real; origin: Point := Pnt(0,0));
|
||||
begin
|
||||
Self.Scale := scale;
|
||||
Self.x := x; Self.y := y; Self.w := w; Self.h := h;
|
||||
Self.origin := origin;
|
||||
CorrectBounds;
|
||||
end;
|
||||
|
||||
function PointInside(p: Point): boolean;
|
||||
begin
|
||||
Result := (p.X >= a) and (p.X <= b) and (p.Y >= min) and (p.Y <= max);
|
||||
end;
|
||||
|
||||
function FindP(Scale: real): real;
|
||||
begin // MinLen = 25 - то самое число
|
||||
var p := Scale;
|
||||
if p < MinLen then
|
||||
while p < MinLen do
|
||||
p *= 10
|
||||
else begin
|
||||
while p >= MinLen * 10 do
|
||||
p /= 10;
|
||||
end;
|
||||
// p in [MinLen..MinLen * 10)
|
||||
if p >= MinLen * 5 then
|
||||
p /= 5
|
||||
else if p >= MinLen *2 then
|
||||
p /= 2;
|
||||
Result := p;
|
||||
end;
|
||||
|
||||
procedure CorrectBounds;
|
||||
begin
|
||||
mx := Scale;
|
||||
my := Scale;
|
||||
a := -w/2/mx;
|
||||
b := -a;
|
||||
max := h/2/my;
|
||||
min := - max;
|
||||
|
||||
XTicks := FindP(Scale)/Scale;
|
||||
YTicks := XTicks;
|
||||
|
||||
var th := TextHeightP('0'); // высота текста
|
||||
// tw - ширина текста - максимум по всем числам
|
||||
var RY0 := GetRY0; // самое маленькое логическое значение по y. Соответствует нижней части экрана
|
||||
var tw := RY0.Step(YTicks).TakeWhile(ry -> ry <= max + origin.y)
|
||||
.Select(y -> TextWidthP(y.Round(YTicksPrecision).ToString)).DefaultIfEmpty.Max;
|
||||
if tw = 0 then
|
||||
tw := TextWidthP('0');
|
||||
var dd := TextWidthP(b.Round(xTicksPrecision).ToString)/2;
|
||||
// dd - это половинка ширины последней цифры
|
||||
//var tw := TextWidth('-99.9');
|
||||
w -= {MarginX * 2 +} spaceBetweenTextAndGraph + tw + dd;
|
||||
h -= MarginY * 2 + spaceBetweenTextAndGraph + th;
|
||||
x += MarginX + spaceBetweenTextAndGraph + tw;
|
||||
y += MarginY;
|
||||
|
||||
// И ещё раз пересчитаем!
|
||||
a := -w/2/mx;
|
||||
b := -a;
|
||||
max := h/2/my;
|
||||
min := - max;
|
||||
|
||||
XTicks := FindP(Scale)/Scale;
|
||||
YTicks := XTicks;
|
||||
end;
|
||||
|
||||
// a,b,min,max - логические
|
||||
function RealToScreenX(xx: real) := x + mx * (xx - origin.x - a);
|
||||
function RealToScreenY(yy: real) := y + h - my * (yy - origin.y - min); // ?
|
||||
function ScreenToRealX(xx: real) := (xx - x) / mx + a + origin.x;
|
||||
function ScreenToRealY(yy: real) := (y + h - yy) / my + min + origin.y;
|
||||
function ScreenToReal(p: Point): Point := Pnt(ScreenToRealX(p.X),ScreenToRealY(p.Y));
|
||||
function RealToScreen(p: Point): Point := Pnt(RealToScreenX(p.X),RealToScreenY(p.Y));
|
||||
|
||||
/// Самое маленькое логическое значение по x
|
||||
function GetRX0: real;
|
||||
begin
|
||||
var xt := XTicks * Trunc(Abs(a + origin.x)/XTicks);
|
||||
var rx0: real;
|
||||
if a + origin.x <= 0 then
|
||||
rx0 := -xt
|
||||
else rx0 := xt + XTicks;
|
||||
Result := rx0;
|
||||
end;
|
||||
|
||||
/// Самое маленькое логическое значение по y
|
||||
function GetRY0: real;
|
||||
begin
|
||||
var yt: real := YTicks * Trunc(Abs(min + origin.y)/YTicks);
|
||||
var ry0: real;
|
||||
if min + origin.y <= 0 then
|
||||
ry0 := -yt
|
||||
else ry0 := yt + YTicks;
|
||||
Result := ry0;
|
||||
end;
|
||||
|
||||
procedure DrawDC(dc: DrawingContext);
|
||||
begin
|
||||
var AxisColor := GrayColor(112);
|
||||
var GridPen := ColorPen(Colors.LightGray,1);
|
||||
var AxisPen := ColorPen(AxisColor,1);
|
||||
|
||||
var stepx := mx * XTicks; // Экранный шаг по оси x
|
||||
var rx0 := GetRX0; // реальная начальная координата по x. При запуске = 14
|
||||
var x0 := RealToScreenX(rx0); // Экранная начальная координата по x.
|
||||
|
||||
// ширина надписи по оси ox
|
||||
var www := PABCSystem.max(TextWidthP(rx0.Round(XTicksPrecision).ToString),
|
||||
TextWidthP((rx0+XTicks).Round(XTicksPrecision).ToString)) + 3;
|
||||
var numTicks := Trunc(w / 2 / stepx);
|
||||
|
||||
var it := 0;
|
||||
if numTicks.IsEven then
|
||||
it += 1;
|
||||
|
||||
while x0<=x+w+0.000001 do
|
||||
begin
|
||||
if Abs(rx0)<0.000001 then
|
||||
dc.DrawLine(AxisPen,Pnt(x0,y),Pnt(x0,y+h))
|
||||
else dc.DrawLine(GridPen,Pnt(x0,y),Pnt(x0,y+h));
|
||||
var text := rx0.Round(XTicksPrecision).ToString;
|
||||
if (www <= stepx) or (it mod 2 = 1) then
|
||||
TextOutDC(dc,x0,y+h+4,text,Alignment.CenterTop);
|
||||
x0 += stepx;
|
||||
rx0 += XTicks;
|
||||
it += 1;
|
||||
end;
|
||||
|
||||
var stepy := my * YTicks;
|
||||
var ry0 := GetRY0;
|
||||
var y0 := RealToScreenY(ry0);
|
||||
|
||||
while y0>=y-0.000001 do
|
||||
begin
|
||||
if Abs(ry0)<0.000001 then
|
||||
DrawLineDC(dc,x,y0,x+w,y0,AxisPen)
|
||||
else DrawLineDC(dc,x,y0,x+w,y0,GridPen);
|
||||
TextOutDC(dc,x-4,y0,ry0.Round(YTicksPrecision).ToString,Alignment.RightCenter);
|
||||
y0 -= stepy;
|
||||
ry0 += YTicks;
|
||||
end;
|
||||
|
||||
DrawRectangleDC(dc, x, y, w, h, nil, ColorPen(Colors.Black,1));
|
||||
end;
|
||||
|
||||
procedure Draw := FastDraw(DrawDC);
|
||||
|
||||
procedure DrawPoints := FastDraw(dc -> begin
|
||||
var sz := 1.2;
|
||||
if Scale < 10 then
|
||||
exit;
|
||||
var a := ScreenToRealX(x); var b := ScreenToRealX(x+w);
|
||||
var min := ScreenToRealY(y+h); var max := ScreenToRealY(y);
|
||||
for var x := Ceil(a) to Floor(b) do
|
||||
for var y := Ceil(min) to Floor(max) do
|
||||
begin
|
||||
var p := RealToScreen(Pnt(x,y));
|
||||
dc.DrawEllipse(ColorBrush(Colors.Black),nil,p,sz,sz);
|
||||
end;
|
||||
end);
|
||||
|
||||
// Примитивы рисования в логических (реальных) координатах, необходимые Черепашке для рисования
|
||||
procedure LineToReal(x,y: real);
|
||||
begin
|
||||
LineTo(RealToScreenX(x),RealToScreenY(y));
|
||||
end;
|
||||
|
||||
procedure MoveToReal(x,y: real);
|
||||
begin
|
||||
MoveTo(RealToScreenX(x),RealToScreenY(y));
|
||||
end;
|
||||
|
||||
procedure CircleReal(r: real);
|
||||
begin
|
||||
var w := Pen.Width;
|
||||
Pen.Width := 1;
|
||||
GraphWPF.Circle(Pen.X,Pen.Y,Scale * r);
|
||||
Pen.Width := w;
|
||||
end;
|
||||
|
||||
procedure CircleRealColor(r: real; c: Color);
|
||||
begin
|
||||
var w := Pen.Width;
|
||||
Pen.Width := 1;
|
||||
GraphWPF.Circle(Pen.X,Pen.Y,Scale * r,c);
|
||||
Pen.Width := w;
|
||||
end;
|
||||
|
||||
procedure PointRealColor(x,y: real; c: Color) := FastDraw(dc ->
|
||||
begin
|
||||
var p := RealToScreen(Pnt(x,y));
|
||||
dc.DrawEllipse(ColorBrush(c),nil,p,PointRadius,PointRadius);
|
||||
end);
|
||||
|
||||
procedure PointsRealColor(points: array of Point; c: Color) := FastDraw(dc ->
|
||||
begin
|
||||
var cc := ColorBrush(c);
|
||||
foreach var p in points do
|
||||
begin
|
||||
var pp := RealToScreen(p);
|
||||
dc.DrawEllipse(cc,nil,pp,PointRadius,PointRadius);
|
||||
end;
|
||||
end);
|
||||
end;
|
||||
|
||||
{$endregion}
|
||||
|
||||
// Переменные для системы координат
|
||||
var
|
||||
Scale := 27.1;
|
||||
Origin := Pnt(0,0);
|
||||
|
||||
// Переменные для Черепашки
|
||||
var
|
||||
tp: Point; // текущая точка Черепахи (экранная, но сделаем её логической)
|
||||
angle: real; // Угол поворота Черепахи
|
||||
dr := False; // Опущен хвост Черепахи или нет
|
||||
|
||||
// Команды для "проигрывания" при перерисовке (изменении масштаба и сдвиге)
|
||||
Commands := new List<ICommand>;
|
||||
|
||||
// Система координат
|
||||
var fso: FS;
|
||||
procedure MoveToReal(x,y: real);
|
||||
begin
|
||||
MoveTo(fso.RealToScreenX(x),fso.RealToScreenY(y));
|
||||
end;
|
||||
|
||||
// Вспомогательные переменные для событий
|
||||
var
|
||||
StartPoint,MousePoint: Point;
|
||||
deltaMultScale := 1.2; // на сколько увеличивать-уменьшать при прокручивании колёсика мыши
|
||||
|
||||
// Вспомогательная переменная для задачи перерисовки
|
||||
var tsk: System.Threading.Tasks.Task := nil; // Задача для перерисовки. В каждый момент одна
|
||||
|
||||
|
||||
{$region Функции создания команд для "проигрывания"}
|
||||
|
||||
{type
|
||||
Command = record
|
||||
typ: CommandType;
|
||||
r,da,x,y: real;
|
||||
points: array of Point;
|
||||
color: GColor;
|
||||
end;}
|
||||
|
||||
{$region Команды Черепахи при "проигрывании"}
|
||||
|
||||
|
|
@ -306,7 +31,7 @@ begin
|
|||
tp += r * Vect(Cos(DegToRad(angle)),Sin(DegToRad(angle)));
|
||||
if dr then
|
||||
dc.DrawLine(CurrentPen,Pnt(Pen.X,Pen.Y),fso.RealToScreen(tp));
|
||||
fso.MoveToReal(tp.X,tp.Y)
|
||||
MoveToReal(tp.X,tp.Y)
|
||||
end;
|
||||
|
||||
procedure TurnPlay(da: real);
|
||||
|
|
@ -327,128 +52,91 @@ end;
|
|||
procedure ToPointPlay(x,y: real);
|
||||
begin
|
||||
tp := Pnt(x,y);
|
||||
fso.MoveToReal(tp.X,tp.Y);
|
||||
MoveToReal(tp.X,tp.Y);
|
||||
end;
|
||||
|
||||
procedure CirclePlay(dc: DrawingContext; r: real; color: GColor);
|
||||
procedure CirclePenPosPlay(dc: DrawingContext; r: real; color: GColor);
|
||||
begin
|
||||
dc.DrawEllipse(ColorBrush(color),ColorPen(Pen.Color,1),fso.RealToScreen(tp),r * Scale,r * Scale);
|
||||
end;
|
||||
|
||||
procedure PointPlay(dc: DrawingContext; x,y: real; color: GColor);
|
||||
begin
|
||||
dc.DrawEllipse(ColorBrush(color),nil,fso.RealToScreen(Pnt(x,y)),PointRadius,PointRadius);
|
||||
end;
|
||||
|
||||
procedure PointsPlay(dc: DrawingContext; points: array of Point; color: GColor);
|
||||
begin
|
||||
var cc := ColorBrush(color);
|
||||
foreach var p in points do
|
||||
begin
|
||||
var pp := fso.RealToScreen(p);
|
||||
dc.DrawEllipse(cc,nil,pp,PointRadius,PointRadius);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SetWidthPlay(r: real);
|
||||
begin
|
||||
CurrentPen := ColorPen(Pen.Color,r);
|
||||
CurrentPen := ColorPen(CurrentPenColor,r);
|
||||
end;
|
||||
|
||||
procedure SetColorPlay(c: GColor);
|
||||
begin
|
||||
CurrentPen := ColorPen(c,Pen.Width);
|
||||
CurrentPen := ColorPen(c,CurrentPen.Thickness);
|
||||
end;
|
||||
|
||||
{$endregion}
|
||||
|
||||
type
|
||||
ForwC = auto class(ICommand)
|
||||
ForwC = auto class(Command)
|
||||
r: real;
|
||||
public
|
||||
procedure Play(dc: DrawingContext);
|
||||
procedure Play(dc: DrawingContext); override;
|
||||
begin
|
||||
ForwPlay(dc,r);
|
||||
end;
|
||||
end;
|
||||
TurnC = auto class(ICommand)
|
||||
TurnC = auto class(Command)
|
||||
da: real;
|
||||
public
|
||||
procedure Play(dc: DrawingContext);
|
||||
procedure Play(dc: DrawingContext); override;
|
||||
begin
|
||||
TurnPlay(da)
|
||||
end;
|
||||
end;
|
||||
UpC = auto class(ICommand)
|
||||
UpC = auto class(Command)
|
||||
public
|
||||
procedure Play(dc: DrawingContext);
|
||||
procedure Play(dc: DrawingContext); override;
|
||||
begin
|
||||
UpPlay
|
||||
end;
|
||||
end;
|
||||
DownC = auto class(ICommand)
|
||||
DownC = auto class(Command)
|
||||
public
|
||||
procedure Play(dc: DrawingContext);
|
||||
procedure Play(dc: DrawingContext); override;
|
||||
begin
|
||||
DownPlay
|
||||
end;
|
||||
end;
|
||||
ToPointC = auto class(ICommand)
|
||||
ToPointC = auto class(Command)
|
||||
x,y: real;
|
||||
public
|
||||
procedure Play(dc: DrawingContext);
|
||||
procedure Play(dc: DrawingContext); override;
|
||||
begin
|
||||
ToPointPlay(x,y);
|
||||
end;
|
||||
end;
|
||||
CircleC = auto class(ICommand)
|
||||
CircleC = auto class(Command)
|
||||
r: real;
|
||||
c: Color;
|
||||
public
|
||||
procedure Play(dc: DrawingContext);
|
||||
procedure Play(dc: DrawingContext); override;
|
||||
begin
|
||||
CirclePlay(dc,r,c);
|
||||
CirclePenPosPlay(dc,r,c);
|
||||
end;
|
||||
end;
|
||||
PointC = auto class(ICommand)
|
||||
x,y: real;
|
||||
c: Color;
|
||||
public
|
||||
procedure Play(dc: DrawingContext);
|
||||
begin
|
||||
PointPlay(dc,x,y,c);
|
||||
end;
|
||||
end;
|
||||
PointsC = auto class(ICommand)
|
||||
points: array of Point;
|
||||
c: Color;
|
||||
public
|
||||
procedure Play(dc: DrawingContext);
|
||||
begin
|
||||
PointsPlay(dc,points,c);
|
||||
end;
|
||||
end;
|
||||
SetWidthC = auto class(ICommand)
|
||||
SetWidthC = auto class(Command)
|
||||
w: real;
|
||||
public
|
||||
procedure Play(dc: DrawingContext);
|
||||
procedure Play(dc: DrawingContext); override;
|
||||
begin
|
||||
SetWidthPlay(w);
|
||||
end;
|
||||
end;
|
||||
SetColorC = auto class(ICommand)
|
||||
SetColorC = auto class(Command)
|
||||
c: Color;
|
||||
public
|
||||
procedure Play(dc: DrawingContext);
|
||||
procedure Play(dc: DrawingContext); override;
|
||||
begin
|
||||
SetColorPlay(c);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure AddCommand(c: ICommand);
|
||||
begin
|
||||
Commands.Add(c);
|
||||
end;
|
||||
|
||||
|
||||
{$endregion}
|
||||
|
||||
|
|
@ -457,6 +145,24 @@ function Window := GraphWPF.Window;
|
|||
// fso - глобальная и всегда инициализированная!!!
|
||||
// tp - в логических (это точка Черепахи)
|
||||
|
||||
// Вспомогательные для Circle
|
||||
procedure CirclePenPosReal(r: real);
|
||||
begin
|
||||
var w := Pen.Width;
|
||||
Pen.Width := 1;
|
||||
GraphWPF.Circle(Pen.X,Pen.Y,fso.Scale * r);
|
||||
Pen.Width := w;
|
||||
end;
|
||||
|
||||
procedure CirclePenPosReal(r: real; c: Color);
|
||||
begin
|
||||
var w := Pen.Width;
|
||||
Pen.Width := 1;
|
||||
GraphWPF.Circle(Pen.X,Pen.Y,fso.Scale * r,c);
|
||||
Pen.Width := w;
|
||||
end;
|
||||
|
||||
|
||||
{$region Команды Черепахи}
|
||||
|
||||
/// Продвигает Черепаху вперёд на расстояние r
|
||||
|
|
@ -476,7 +182,7 @@ begin
|
|||
end
|
||||
);
|
||||
end;
|
||||
fso.MoveToReal(tp.X,tp.Y)
|
||||
MoveToReal(tp.X,tp.Y)
|
||||
end;
|
||||
|
||||
/// Продвигает Черепаху назад на расстояние r
|
||||
|
|
@ -514,70 +220,47 @@ procedure ToPoint(x,y: real);
|
|||
begin
|
||||
AddCommand(new ToPointC(x,y));
|
||||
tp := Pnt(x,y);
|
||||
fso.MoveToReal(tp.X,tp.Y);
|
||||
MoveToReal(tp.X,tp.Y);
|
||||
end;
|
||||
|
||||
// Это в Turtle добавление
|
||||
/// Рисует окружность указанного радиуса
|
||||
procedure Circle(r: real);
|
||||
begin
|
||||
fso.CircleReal(r);
|
||||
CirclePenPosReal(r);
|
||||
AddCommand(new CircleC(r,Colors.White));
|
||||
end;
|
||||
|
||||
/// Рисует окружность указанного радиуса и цвета
|
||||
procedure Circle(r: real; color: GColor);
|
||||
begin
|
||||
fso.CircleRealColor(r,color);
|
||||
CirclePenPosReal(r,color);
|
||||
AddCommand(new CircleC(r,color));
|
||||
end;
|
||||
|
||||
/// Рисует точку заданным цветом
|
||||
procedure DrawPoint(x,y: real; color: GColor := Colors.Black);
|
||||
begin
|
||||
fso.PointRealColor(x,y,color);
|
||||
AddCommand(new PointC(x,y,color));
|
||||
end;
|
||||
procedure DrawPoint(x,y: real; color: GColor := Colors.Black; PointRadius: real := 2) := Coords.DrawPoint(x,y,color,PointRadius);
|
||||
|
||||
/// Рисует точки заданным цветом
|
||||
procedure DrawPoints(points: array of Point; color: GColor);
|
||||
begin
|
||||
fso.PointsRealColor(points,color);
|
||||
AddCommand(new PointsC(points,color));
|
||||
end;
|
||||
procedure DrawPoints(points: array of Point; color: GColor; PointRadius: real := 2) := Coords.DrawPoints(points,color,PointRadius);
|
||||
|
||||
/// Рисует точки следующим цветом в палитре цветов
|
||||
procedure DrawPoints(points: array of Point);
|
||||
begin
|
||||
var color := Palette[PaletteIndex];
|
||||
PaletteIndex += 1;
|
||||
if PaletteIndex >= Palette.Length then
|
||||
PaletteIndex := 0;
|
||||
DrawPoints(points,color);
|
||||
end;
|
||||
procedure DrawPoints(points: array of Point; PointRadius: real := 2) := Coords.DrawPoints(points,PointRadius);
|
||||
|
||||
/// Рисует точки заданным цветом
|
||||
procedure DrawPoints(xx,yy: array of real; color: GColor);
|
||||
begin
|
||||
var points := Zip(xx,yy,(x,y) -> Pnt(x,y)).ToArray;
|
||||
DrawPoints(points,color);
|
||||
end;
|
||||
procedure DrawPoints(xx,yy: array of real; color: GColor; PointRadius: real := 2) := Coords.DrawPoints(xx,yy,color,PointRadius);
|
||||
|
||||
/// Рисует точки следующим цветом в палитре цветов
|
||||
procedure DrawPoints(xx,yy: array of real);
|
||||
begin
|
||||
var points := Zip(xx,yy,(x,y) -> Pnt(x,y)).ToArray;
|
||||
DrawPoints(points);
|
||||
end;
|
||||
procedure DrawPoints(xx,yy: array of real; PointRadius: real := 2) := Coords.DrawPoints(xx,yy,PointRadius);
|
||||
|
||||
|
||||
/// Устанавливает ширину линии
|
||||
/// Устанавливает ширину линии Черепахи
|
||||
procedure SetWidth(w: real);
|
||||
begin
|
||||
CurrentPen := ColorPen(Pen.Color,w);
|
||||
Pen.Width := w;
|
||||
end;
|
||||
|
||||
/// Устанавливает цвет линии
|
||||
/// Устанавливает цвет линии Черепахи
|
||||
procedure SetColor(c: GColor);
|
||||
begin
|
||||
CurrentPen := ColorPen(c,Pen.Width);
|
||||
|
|
@ -586,134 +269,28 @@ end;
|
|||
|
||||
{$endregion}
|
||||
|
||||
|
||||
/// Установка положения начала координат
|
||||
procedure SetOrigin(x,y: real);
|
||||
begin
|
||||
Origin := Pnt(x,y);
|
||||
Coords.SetOrigin(x,y);
|
||||
Up;
|
||||
ToPoint(x,y);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
var cansellation := False;
|
||||
|
||||
procedure PlayCommands;
|
||||
begin
|
||||
FastDraw(dc -> begin
|
||||
dc.PushClip(new System.Windows.Media.RectangleGeometry(Rect(fso.x,fso.y,fso.w,fso.h)));
|
||||
foreach var command in commands do
|
||||
command.Play(dc);
|
||||
dc.Pop;
|
||||
end);
|
||||
end;
|
||||
|
||||
procedure InitTurtle;
|
||||
begin
|
||||
tp := (0,0);
|
||||
angle := 90;
|
||||
fso.MoveToReal(tp.X,tp.Y);
|
||||
MoveToReal(tp.X,tp.Y);
|
||||
end;
|
||||
|
||||
var DrawCoords := 1;
|
||||
|
||||
procedure InitCoordinates;
|
||||
begin
|
||||
fso := new FS(Scale,0,0,Window.Width,Window.Height,Origin);
|
||||
if DrawCoords = 1 then
|
||||
fso.Draw
|
||||
else if DrawCoords = 2 then
|
||||
begin
|
||||
fso.Draw;
|
||||
fso.DrawPoints;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Redraw;
|
||||
begin
|
||||
if (tsk <> nil) and not tsk.IsCompleted then
|
||||
exit;
|
||||
tsk := Task.Run(() -> begin
|
||||
GraphWPF.Redraw(()->begin
|
||||
Window.Clear;
|
||||
InitCoordinates;
|
||||
InitTurtle;
|
||||
PlayCommands;
|
||||
end)
|
||||
end)
|
||||
end;
|
||||
|
||||
procedure MouseDown(x,y: real; mb: integer);
|
||||
begin
|
||||
StartPoint := Pnt(x,y);
|
||||
end;
|
||||
|
||||
var AfterResize := False;
|
||||
|
||||
procedure MouseMove(x,y: real; mb: integer);
|
||||
begin
|
||||
if AfterResize then
|
||||
begin
|
||||
AfterResize := False;
|
||||
exit;
|
||||
end;
|
||||
if (tsk<>nil) and not tsk.IsCompleted then
|
||||
exit;
|
||||
MousePoint := Pnt(x,y);
|
||||
if mb<>1 then
|
||||
exit;
|
||||
var v := fso.ScreenToReal(MousePoint) - fso.ScreenToReal(StartPoint);
|
||||
Origin.X -= v.X;
|
||||
Origin.Y -= v.Y;
|
||||
StartPoint := MousePoint;
|
||||
Redraw;
|
||||
end;
|
||||
|
||||
|
||||
procedure MouseWheel(delta: real);
|
||||
begin
|
||||
if (tsk<>nil) and not tsk.IsCompleted then
|
||||
exit;
|
||||
|
||||
if delta > 0 then // вверх - увеличение
|
||||
begin
|
||||
if MinLen/Scale > 0.0001 then
|
||||
Scale *= deltaMultScale
|
||||
else exit;
|
||||
Origin := Origin + (deltaMultScale - 1)/deltaMultScale * (fso.ScreenToReal(mousePoint) - Origin);
|
||||
end
|
||||
else
|
||||
begin
|
||||
if MinLen/Scale < 500 then
|
||||
Scale /= deltaMultScale
|
||||
else exit;
|
||||
Origin := Origin - (deltaMultScale - 1) * (fso.ScreenToReal(mousePoint) - Origin);
|
||||
end;
|
||||
Redraw;
|
||||
end;
|
||||
|
||||
procedure SetScale(sc: real);
|
||||
begin
|
||||
Scale := sc;
|
||||
Window.Clear;
|
||||
InitCoordinates;
|
||||
InitTurtle;
|
||||
end;
|
||||
|
||||
|
||||
procedure Init;
|
||||
procedure InitOnce; // Это тоже относится к Черепахе
|
||||
begin
|
||||
Window.Title := 'Исполнитель Черепаха';
|
||||
Font.Size := 12;
|
||||
Pen.RoundCap := True;
|
||||
end;
|
||||
|
||||
procedure Resize;
|
||||
begin
|
||||
Redraw;
|
||||
AfterResize := True;
|
||||
end;
|
||||
|
||||
procedure KeyDown(k: Key);
|
||||
begin
|
||||
case k of
|
||||
|
|
@ -728,14 +305,9 @@ begin
|
|||
end;
|
||||
|
||||
initialization
|
||||
Init;
|
||||
InitCoordinates;
|
||||
InitProc := InitTurtle;
|
||||
InitTurtle;
|
||||
InitOnce;
|
||||
finalization
|
||||
Redraw;
|
||||
OnMouseWheel := MouseWheel;
|
||||
OnMouseDown := MouseDown;
|
||||
OnMouseMove := MouseMove;
|
||||
OnResize := Resize;
|
||||
OnKeyDown := KeyDown;
|
||||
end.
|
||||
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
NAME_CANNOT_HAVE_GENERIC_PARAMETERS_{0}=Name {0} can not have generic parameters
|
||||
AUTO_CLASS_MUST_NOT_HAVE_POINTERS=Auto class can not have fields of pointer type
|
||||
AUTO_CLASS_MUST_NOT_HAVE_PARENTS=Auto class can not have parents
|
||||
AUTO_CLASS_MUST_NOT_HAVE_PARENTS_WITH_FIELDS=Auto class can not have parents with fields
|
||||
AUTO_CLASS_MUST_NOT_HAVE_UNNAMED_ENUMS=Auto class can not have fields with unnamed enums type
|
||||
AUTO_CLASS_MUST_NOT_HAVE_EVENTS=Auto class can not have events
|
||||
AUTO_CLASS_MUST_NOT_HAVE_PROPERTIES=Auto class can not have properties
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
NAME_CANNOT_HAVE_GENERIC_PARAMETERS_{0}=Имя {0} не может иметь обобщенные параметры
|
||||
AUTO_CLASS_MUST_NOT_HAVE_POINTERS=Авто класс не может иметь поля, являющиеся указателями
|
||||
AUTO_CLASS_MUST_NOT_HAVE_PARENTS=Авто класс не может иметь предков
|
||||
AUTO_CLASS_MUST_NOT_HAVE_PARENTS_WITH_FIELDS=Авто класс не может иметь предков, содержащих поля
|
||||
AUTO_CLASS_MUST_NOT_HAVE_UNNAMED_ENUMS=Авто класс не может иметь полей с неименованными перечислимыми типами
|
||||
AUTO_CLASS_MUST_NOT_HAVE_EVENTS=Авто класс не может иметь поля, являющиеся событиями
|
||||
AUTO_CLASS_MUST_NOT_HAVE_PROPERTIES=Авто класс не может иметь свойства
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
NAME_CANNOT_HAVE_GENERIC_PARAMETERS_{0}=Ім'я {0} не може мати узагальнені параметри
|
||||
AUTO_CLASS_MUST_NOT_HAVE_POINTERS=Авто клас не може мати поля, що є вказівниками
|
||||
AUTO_CLASS_MUST_NOT_HAVE_PARENTS=Авто клас не може мати предків або реалізовувати інтерфейси
|
||||
AUTO_CLASS_MUST_NOT_HAVE_PARENTS_WITH_FIELDS=Авто клас не може мати предків с полями
|
||||
UNDEFINED_NAME_REFERENCE_{0}=Невідоме ім'я '{0}'
|
||||
TWO_TYPE_CONVERTIONS_POSSIBLE_FIRST_TYPE_{0}_SECOND_TYE_{1}=Можливі два перетворення типу: до типу {0} і до типу {1}
|
||||
CAN_NOT_CONVERT_TYPES_FROM_{0}_TO_{1}=Не можна перетворити тип {0} до {1}
|
||||
|
|
|
|||
Loading…
Reference in a new issue