From e91e3539848359b5cb2f04e2f406e1cfab3da905 Mon Sep 17 00:00:00 2001 From: Mikhalkovich Stanislav Date: Sun, 11 Aug 2024 15:21:29 +0300 Subject: [PATCH] =?UTF-8?q?=D0=9E=D0=B1=D0=BD=D0=BE=D0=B2=D0=BB=D0=B5?= =?UTF-8?q?=D0=BD=D0=BD=D1=8B=D0=B9=20=D0=BC=D0=BE=D0=B4=D1=83=D0=BB=D1=8C?= =?UTF-8?q?=20Turtle.pas?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Configuration/GlobalAssemblyInfo.cs | 2 +- Configuration/Version.defs | 4 +- Release/pabcversion.txt | 2 +- ReleaseGenerators/PascalABCNET_version.nsh | 2 +- TestSuite/CompilationSamples/Turtle.pas | 623 ++++++++++++++++++++- bin/Lib/Turtle.pas | 623 ++++++++++++++++++++- 6 files changed, 1207 insertions(+), 49 deletions(-) diff --git a/Configuration/GlobalAssemblyInfo.cs b/Configuration/GlobalAssemblyInfo.cs index 6ba165636..e8767d148 100644 --- a/Configuration/GlobalAssemblyInfo.cs +++ b/Configuration/GlobalAssemblyInfo.cs @@ -15,7 +15,7 @@ internal static class RevisionClass public const string Major = "3"; public const string Minor = "9"; public const string Build = "0"; - public const string Revision = "3523"; + public const string Revision = "3524"; public const string MainVersion = Major + "." + Minor; public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision; diff --git a/Configuration/Version.defs b/Configuration/Version.defs index 648ec4a01..55010fa42 100644 --- a/Configuration/Version.defs +++ b/Configuration/Version.defs @@ -1,4 +1,4 @@ -%MINOR%=9 -%REVISION%=3523 %COREVERSION%=0 +%REVISION%=3524 +%MINOR%=9 %MAJOR%=3 diff --git a/Release/pabcversion.txt b/Release/pabcversion.txt index 28cc581bc..3452f64a7 100644 --- a/Release/pabcversion.txt +++ b/Release/pabcversion.txt @@ -1 +1 @@ -3.9.0.3523 +3.9.0.3524 diff --git a/ReleaseGenerators/PascalABCNET_version.nsh b/ReleaseGenerators/PascalABCNET_version.nsh index 08bcdcd34..bb5e12ddc 100644 --- a/ReleaseGenerators/PascalABCNET_version.nsh +++ b/ReleaseGenerators/PascalABCNET_version.nsh @@ -1 +1 @@ -!define VERSION '3.9.0.3523' +!define VERSION '3.9.0.3524' diff --git a/TestSuite/CompilationSamples/Turtle.pas b/TestSuite/CompilationSamples/Turtle.pas index 83d531e26..17f50d699 100644 --- a/TestSuite/CompilationSamples/Turtle.pas +++ b/TestSuite/CompilationSamples/Turtle.pas @@ -1,52 +1,631 @@ /// Исполнитель Черепаха unit Turtle; +uses GraphWPFBase; uses GraphWPF; +uses System.Threading.Tasks; -type Colors = GraphWPF.Colors; +type + Colors = GraphWPF.Colors; + CommandType = (ForwComm,TurnComm,CircleComm,UpComm,DownComm,ToPointComm,SetColorComm,SetWidthComm); + Command = record + typ: CommandType; + r,da,x,y: real; + color: GColor; + end; var - tp: Point; - a: real := 0; - dr := False; + CurrentPen := ColorPen(Colors.Black,1); -/// Поворачивает Черепаху на угол da по часовой стрелке -procedure Turn(da: real); +{$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) + .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; + end; + +{$endregion} + +// Переменные для системы координат +var + Scale := 27.1; + Origin := Pnt(0,0); + +// Переменные для Черепашки +var + tp: Point; // текущая точка Черепахи (экранная, но сделаем её логической) + angle: real; // Угол поворота Черепахи + dr := False; // Опущен хвост Черепахи или нет + +// Команды для "проигрывания" при перерисовке (изменении масштаба и сдвиге) + Commands := new List; + +// Система координат +var fso: FS; + +// Вспомогательные переменные для событий +var + StartPoint,MousePoint: Point; + deltaMultScale := 1.2; // на сколько увеличивать-уменьшать при прокручивании колёсика мыши + +// Вспомогательная переменная для задачи перерисовки +var tsk: System.Threading.Tasks.Task := nil; // Задача для перерисовки. В каждый момент одна + + +{$region Функции создания команд для "проигрывания"} + +function ForwC(r: real): Command; begin - a += da; + Result.typ := ForwComm; + Result.r := r; end; +function TurnC(da: real): Command; +begin + Result.typ := TurnComm; + Result.da := da; +end; + +function UpC: Command; +begin + Result.typ := UpComm; +end; + +function DownC: Command; +begin + Result.typ := DownComm; +end; + +function ToPointC(x,y: real): Command; +begin + Result.typ := ToPointComm; + Result.x := x; + Result.y := y; +end; + +function CircleC(r: real; c: GColor): Command; +begin + Result.typ := CircleComm; + Result.r := r; + Result.color := c; +end; + +function SetWidthC(r: real): Command; +begin + Result.typ := SetWidthComm; + Result.r := r; +end; + +function SetColorC(c: GColor): Command; +begin + Result.typ := SetColorComm; + Result.color := c; +end; + + +procedure AddCommand(c: Command); +begin + Commands.Add(c); +end; + +{$endregion} + +function Window := GraphWPF.Window; + +// fso - глобальная и всегда инициализированная!!! +// tp - в логических (это точка Черепахи) + +{$region Команды Черепахи} + /// Продвигает Черепаху вперёд на расстояние r procedure Forw(r: real); begin - tp += r * Vect(Cos(DegToRad(a)),Sin(DegToRad(a))); - if dr then - LineTo(tp.X,tp.Y) - else MoveTo(tp.X,tp.Y) + AddCommand(ForwC(r)); + tp += r * Vect(Cos(DegToRad(angle)),Sin(DegToRad(angle))); + var p1 := Pnt(Pen.X,Pen.Y); + var p2 := fso.RealToScreen(tp); + //var p1r := fso.ScreenToReal(p1); + //var b1 := fso.PointInside(p1r); + //var b2 := fso.PointInside(tp); + if dr {and (b1 or b2)} then + begin + FastDraw(dc -> begin + dc.DrawLine(CurrentPen,p1,p2); + end + ); + end; + fso.MoveToReal(tp.X,tp.Y) end; +/// Продвигает Черепаху назад на расстояние r +procedure Back(r: real) := Forw(-r); + +/// Поворачивает Черепаху на угол da по часовой стрелке +procedure Turn(da: real); +begin + angle -= da; + AddCommand(TurnC(da)); +end; + +/// Поворачивает Черепаху на угол da по часовой стрелке +procedure TurnRight(da: real) := Turn(da); + +/// Поворачивает Черепаху на угол da против часовой стрелки +procedure TurnLeft(da: real) := Turn(-da); + /// Опускает хвост Черепахи -procedure Down := dr := True; +procedure Down; +begin + AddCommand(DownC); + dr := True; +end; /// Поднимает хвост Черепахи -procedure Up := dr := False; +procedure Up; +begin + AddCommand(UpC); + dr := False; +end; -/// Устанавливает ширину линии -procedure SetWidth(w: real) := Pen.Width := w; - -/// Устанавливает цвет линии -procedure SetColor(c: GColor) := Pen.Color := c; +procedure ToPointPlay(x,y: real); forward; /// Перемещает Черепаху в точку (x,y) procedure ToPoint(x,y: real); begin + AddCommand(ToPointC(x,y)); tp := Pnt(x,y); - MoveTo(tp.X,tp.Y); + fso.MoveToReal(tp.X,tp.Y); end; +procedure Circle(r: real); begin - //tp := Pnt(Window.Width / 2, Window.Height / 2); - tp := Pnt(400,300); + fso.CircleReal(r); + AddCommand(CircleC(r,Colors.White)); +end; + +/// Рисует окружность указанного радиуса и цвета +procedure Circle(r: real; color: GColor); +begin + fso.CircleRealColor(r,color); + AddCommand(CircleC(r,color)); +end; + +/// Устанавливает ширину линии +procedure SetWidth(w: real); +begin + CurrentPen := ColorPen(Pen.Color,w); + Pen.Width := w; +end; + +/// Устанавливает цвет линии +procedure SetColor(c: GColor); +begin + CurrentPen := ColorPen(c,Pen.Width); + Pen.Color := c; +end; + +{$endregion} + + +procedure SetOrigin(x,y: real); +begin + Origin := Pnt(x,y); + Up; + ToPoint(x,y); +end; + +{$region Команды Черепахи при "проигрывании"} + +// Сделаем свои команды ForwPlay, TurnPlay, CirclePlay и т.д. + +procedure TurnPlay(da: real); +begin + angle -= da; +end; + +/// Продвигает Черепаху вперёд на расстояние r +procedure ForwPlay(dc: DrawingContext; r: real); +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) +end; + +procedure DownPlay; +begin + dr := True; +end; + +procedure UpPlay; +begin + dr := False; +end; + +procedure ToPointPlay(x,y: real); +begin + tp := Pnt(x,y); + fso.MoveToReal(tp.X,tp.Y); +end; + +procedure CirclePlay(dc: DrawingContext; r: real; color: GColor); +begin + dc.DrawEllipse(ColorBrush(color),ColorPen(Pen.Color,1),fso.RealToScreen(tp),r * Scale,r * Scale); +end; + +procedure SetWidthPlay(r: real); +begin + CurrentPen := ColorPen(Pen.Color,r); +end; + +procedure SetColorPlay(c: GColor); +begin + CurrentPen := ColorPen(c,Pen.Width); +end; + +{$endregion} + +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 + begin + {if cansellation then + break;} + case command.Typ of + ForwComm: ForwPlay(dc,command.r); + TurnComm: TurnPlay(command.da); + UpComm: UpPlay; + DownComm: DownPlay; + ToPointComm: ToPointPlay(command.x,command.y); + CircleComm: CirclePlay(dc,command.r,command.color); + SetWidthComm: SetWidthPlay(command.r); + SetColorComm: SetColorPlay(command.color); + end; + end; + dc.Pop; + end); +end; + +procedure InitTurtle; +begin + tp := (0,0); + angle := 90; + fso.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; +begin + Window.Title := 'Исполнитель Черепаха'; + Font.Size := 12; Pen.RoundCap := True; - MoveTo(tp.X,tp.Y); +end; + +procedure Resize; +begin + Redraw; + AfterResize := True; +end; + +procedure KeyDown(k: Key); +begin + case k of + key.Space: + begin + DrawCoords += 1; + if DrawCoords > 2 then + DrawCoords := 0; + Redraw; + end; + end; +end; + +initialization + Init; + InitCoordinates; + InitTurtle; +finalization + Redraw; + OnMouseWheel := MouseWheel; + OnMouseDown := MouseDown; + OnMouseMove := MouseMove; + OnResize := Resize; + OnKeyDown := KeyDown; end. \ No newline at end of file diff --git a/bin/Lib/Turtle.pas b/bin/Lib/Turtle.pas index 83d531e26..17f50d699 100644 --- a/bin/Lib/Turtle.pas +++ b/bin/Lib/Turtle.pas @@ -1,52 +1,631 @@ /// Исполнитель Черепаха unit Turtle; +uses GraphWPFBase; uses GraphWPF; +uses System.Threading.Tasks; -type Colors = GraphWPF.Colors; +type + Colors = GraphWPF.Colors; + CommandType = (ForwComm,TurnComm,CircleComm,UpComm,DownComm,ToPointComm,SetColorComm,SetWidthComm); + Command = record + typ: CommandType; + r,da,x,y: real; + color: GColor; + end; var - tp: Point; - a: real := 0; - dr := False; + CurrentPen := ColorPen(Colors.Black,1); -/// Поворачивает Черепаху на угол da по часовой стрелке -procedure Turn(da: real); +{$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) + .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; + end; + +{$endregion} + +// Переменные для системы координат +var + Scale := 27.1; + Origin := Pnt(0,0); + +// Переменные для Черепашки +var + tp: Point; // текущая точка Черепахи (экранная, но сделаем её логической) + angle: real; // Угол поворота Черепахи + dr := False; // Опущен хвост Черепахи или нет + +// Команды для "проигрывания" при перерисовке (изменении масштаба и сдвиге) + Commands := new List; + +// Система координат +var fso: FS; + +// Вспомогательные переменные для событий +var + StartPoint,MousePoint: Point; + deltaMultScale := 1.2; // на сколько увеличивать-уменьшать при прокручивании колёсика мыши + +// Вспомогательная переменная для задачи перерисовки +var tsk: System.Threading.Tasks.Task := nil; // Задача для перерисовки. В каждый момент одна + + +{$region Функции создания команд для "проигрывания"} + +function ForwC(r: real): Command; begin - a += da; + Result.typ := ForwComm; + Result.r := r; end; +function TurnC(da: real): Command; +begin + Result.typ := TurnComm; + Result.da := da; +end; + +function UpC: Command; +begin + Result.typ := UpComm; +end; + +function DownC: Command; +begin + Result.typ := DownComm; +end; + +function ToPointC(x,y: real): Command; +begin + Result.typ := ToPointComm; + Result.x := x; + Result.y := y; +end; + +function CircleC(r: real; c: GColor): Command; +begin + Result.typ := CircleComm; + Result.r := r; + Result.color := c; +end; + +function SetWidthC(r: real): Command; +begin + Result.typ := SetWidthComm; + Result.r := r; +end; + +function SetColorC(c: GColor): Command; +begin + Result.typ := SetColorComm; + Result.color := c; +end; + + +procedure AddCommand(c: Command); +begin + Commands.Add(c); +end; + +{$endregion} + +function Window := GraphWPF.Window; + +// fso - глобальная и всегда инициализированная!!! +// tp - в логических (это точка Черепахи) + +{$region Команды Черепахи} + /// Продвигает Черепаху вперёд на расстояние r procedure Forw(r: real); begin - tp += r * Vect(Cos(DegToRad(a)),Sin(DegToRad(a))); - if dr then - LineTo(tp.X,tp.Y) - else MoveTo(tp.X,tp.Y) + AddCommand(ForwC(r)); + tp += r * Vect(Cos(DegToRad(angle)),Sin(DegToRad(angle))); + var p1 := Pnt(Pen.X,Pen.Y); + var p2 := fso.RealToScreen(tp); + //var p1r := fso.ScreenToReal(p1); + //var b1 := fso.PointInside(p1r); + //var b2 := fso.PointInside(tp); + if dr {and (b1 or b2)} then + begin + FastDraw(dc -> begin + dc.DrawLine(CurrentPen,p1,p2); + end + ); + end; + fso.MoveToReal(tp.X,tp.Y) end; +/// Продвигает Черепаху назад на расстояние r +procedure Back(r: real) := Forw(-r); + +/// Поворачивает Черепаху на угол da по часовой стрелке +procedure Turn(da: real); +begin + angle -= da; + AddCommand(TurnC(da)); +end; + +/// Поворачивает Черепаху на угол da по часовой стрелке +procedure TurnRight(da: real) := Turn(da); + +/// Поворачивает Черепаху на угол da против часовой стрелки +procedure TurnLeft(da: real) := Turn(-da); + /// Опускает хвост Черепахи -procedure Down := dr := True; +procedure Down; +begin + AddCommand(DownC); + dr := True; +end; /// Поднимает хвост Черепахи -procedure Up := dr := False; +procedure Up; +begin + AddCommand(UpC); + dr := False; +end; -/// Устанавливает ширину линии -procedure SetWidth(w: real) := Pen.Width := w; - -/// Устанавливает цвет линии -procedure SetColor(c: GColor) := Pen.Color := c; +procedure ToPointPlay(x,y: real); forward; /// Перемещает Черепаху в точку (x,y) procedure ToPoint(x,y: real); begin + AddCommand(ToPointC(x,y)); tp := Pnt(x,y); - MoveTo(tp.X,tp.Y); + fso.MoveToReal(tp.X,tp.Y); end; +procedure Circle(r: real); begin - //tp := Pnt(Window.Width / 2, Window.Height / 2); - tp := Pnt(400,300); + fso.CircleReal(r); + AddCommand(CircleC(r,Colors.White)); +end; + +/// Рисует окружность указанного радиуса и цвета +procedure Circle(r: real; color: GColor); +begin + fso.CircleRealColor(r,color); + AddCommand(CircleC(r,color)); +end; + +/// Устанавливает ширину линии +procedure SetWidth(w: real); +begin + CurrentPen := ColorPen(Pen.Color,w); + Pen.Width := w; +end; + +/// Устанавливает цвет линии +procedure SetColor(c: GColor); +begin + CurrentPen := ColorPen(c,Pen.Width); + Pen.Color := c; +end; + +{$endregion} + + +procedure SetOrigin(x,y: real); +begin + Origin := Pnt(x,y); + Up; + ToPoint(x,y); +end; + +{$region Команды Черепахи при "проигрывании"} + +// Сделаем свои команды ForwPlay, TurnPlay, CirclePlay и т.д. + +procedure TurnPlay(da: real); +begin + angle -= da; +end; + +/// Продвигает Черепаху вперёд на расстояние r +procedure ForwPlay(dc: DrawingContext; r: real); +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) +end; + +procedure DownPlay; +begin + dr := True; +end; + +procedure UpPlay; +begin + dr := False; +end; + +procedure ToPointPlay(x,y: real); +begin + tp := Pnt(x,y); + fso.MoveToReal(tp.X,tp.Y); +end; + +procedure CirclePlay(dc: DrawingContext; r: real; color: GColor); +begin + dc.DrawEllipse(ColorBrush(color),ColorPen(Pen.Color,1),fso.RealToScreen(tp),r * Scale,r * Scale); +end; + +procedure SetWidthPlay(r: real); +begin + CurrentPen := ColorPen(Pen.Color,r); +end; + +procedure SetColorPlay(c: GColor); +begin + CurrentPen := ColorPen(c,Pen.Width); +end; + +{$endregion} + +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 + begin + {if cansellation then + break;} + case command.Typ of + ForwComm: ForwPlay(dc,command.r); + TurnComm: TurnPlay(command.da); + UpComm: UpPlay; + DownComm: DownPlay; + ToPointComm: ToPointPlay(command.x,command.y); + CircleComm: CirclePlay(dc,command.r,command.color); + SetWidthComm: SetWidthPlay(command.r); + SetColorComm: SetColorPlay(command.color); + end; + end; + dc.Pop; + end); +end; + +procedure InitTurtle; +begin + tp := (0,0); + angle := 90; + fso.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; +begin + Window.Title := 'Исполнитель Черепаха'; + Font.Size := 12; Pen.RoundCap := True; - MoveTo(tp.X,tp.Y); +end; + +procedure Resize; +begin + Redraw; + AfterResize := True; +end; + +procedure KeyDown(k: Key); +begin + case k of + key.Space: + begin + DrawCoords += 1; + if DrawCoords > 2 then + DrawCoords := 0; + Redraw; + end; + end; +end; + +initialization + Init; + InitCoordinates; + InitTurtle; +finalization + Redraw; + OnMouseWheel := MouseWheel; + OnMouseDown := MouseDown; + OnMouseMove := MouseMove; + OnResize := Resize; + OnKeyDown := KeyDown; end. \ No newline at end of file