From e456ad528e737ad889f04b8df600a841d382fdbc Mon Sep 17 00:00:00 2001 From: Mikhalkovich Stanislav Date: Sat, 24 Aug 2024 23:13:57 +0300 Subject: [PATCH] 3.9.0.3530 --- Configuration/GlobalAssemblyInfo.cs | 2 +- Configuration/Version.defs | 4 +- Release/pabcversion.txt | 2 +- ReleaseGenerators/PascalABCNET_version.nsh | 2 +- TestSuite/CompilationSamples/Turtle.pas | 99 +++++++++++++++++++++- 5 files changed, 102 insertions(+), 7 deletions(-) diff --git a/Configuration/GlobalAssemblyInfo.cs b/Configuration/GlobalAssemblyInfo.cs index ac3c1a847..46c0c9827 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 = "3529"; + public const string Revision = "3530"; 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 7f46dba3b..fe94e4b96 100644 --- a/Configuration/Version.defs +++ b/Configuration/Version.defs @@ -1,4 +1,4 @@ -%MINOR%=9 -%REVISION%=3529 %COREVERSION%=0 +%REVISION%=3530 +%MINOR%=9 %MAJOR%=3 diff --git a/Release/pabcversion.txt b/Release/pabcversion.txt index fda7a95a9..d9ea4b2a1 100644 --- a/Release/pabcversion.txt +++ b/Release/pabcversion.txt @@ -1 +1 @@ -3.9.0.3529 +3.9.0.3530 diff --git a/ReleaseGenerators/PascalABCNET_version.nsh b/ReleaseGenerators/PascalABCNET_version.nsh index 7be4ae2a7..b570bd82e 100644 --- a/ReleaseGenerators/PascalABCNET_version.nsh +++ b/ReleaseGenerators/PascalABCNET_version.nsh @@ -1 +1 @@ -!define VERSION '3.9.0.3529' +!define VERSION '3.9.0.3530' diff --git a/TestSuite/CompilationSamples/Turtle.pas b/TestSuite/CompilationSamples/Turtle.pas index 67e3cfdb2..f90a201be 100644 --- a/TestSuite/CompilationSamples/Turtle.pas +++ b/TestSuite/CompilationSamples/Turtle.pas @@ -7,19 +7,26 @@ uses System.Threading.Tasks; type Colors = GraphWPF.Colors; - CommandType = (ForwComm,TurnComm,CircleComm,UpComm,DownComm,ToPointComm,SetColorComm,SetWidthComm); + CommandType = (ForwComm,TurnComm,CircleComm,PointComm,PointsComm,UpComm,DownComm,ToPointComm,SetColorComm,SetWidthComm); 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 @@ -87,7 +94,7 @@ type var th := TextHeightP('0'); // высота текста // tw - ширина текста - максимум по всем числам var RY0 := GetRY0; // самое маленькое логическое значение по y. Соответствует нижней части экрана - var tw := RY0.Step(YTicks).TakeWhile(ry -> ry <= max) + 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'); @@ -230,6 +237,22 @@ type 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} @@ -298,6 +321,21 @@ begin Result.color := c; end; +function PointC(x,y: real; c: GColor): Command; +begin + Result.typ := PointComm; + Result.x := x; + Result.y := y; + Result.color := c; +end; + +function PointsC(points: array of Point; c: GColor): Command; +begin + Result.typ := PointsComm; + Result.points := points; + Result.color := c; +end; + function SetWidthC(r: real): Command; begin Result.typ := SetWidthComm; @@ -385,6 +423,7 @@ begin fso.MoveToReal(tp.X,tp.Y); end; +/// Рисует окружность указанного радиуса procedure Circle(r: real); begin fso.CircleReal(r); @@ -398,6 +437,45 @@ begin AddCommand(CircleC(r,color)); end; +/// Рисует точку заданным цветом +procedure DrawPoint(x,y: real; color: GColor := Colors.Black); +begin + fso.PointRealColor(x,y,color); + AddCommand(PointC(x,y,color)); +end; + +/// Рисует точки заданным цветом +procedure DrawPoints(points: array of Point; color: GColor); +begin + fso.PointsRealColor(points,color); + AddCommand(PointsC(points,color)); +end; + +/// Рисует точки следующим цветом в палитре цветов +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(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); +begin + var points := Zip(xx,yy,(x,y) -> Pnt(x,y)).ToArray; + DrawPoints(points); +end; + + /// Устанавливает ширину линии procedure SetWidth(w: real); begin @@ -461,6 +539,21 @@ 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); @@ -490,6 +583,8 @@ begin DownComm: DownPlay; ToPointComm: ToPointPlay(command.x,command.y); CircleComm: CirclePlay(dc,command.r,command.color); + PointComm: PointPlay(dc,command.x,command.y,command.color); + PointsComm: PointsPlay(dc,command.points,command.color); SetWidthComm: SetWidthPlay(command.r); SetColorComm: SetColorPlay(command.color); end;