From 4d547d9af3bff3ca54be70b6bfe05d3da6c70510 Mon Sep 17 00:00:00 2001 From: Mikhalkovich Stanislav Date: Thu, 16 May 2019 15:42:16 +0300 Subject: [PATCH] DrawPixels --- Configuration/GlobalAssemblyInfo.cs | 2 +- Configuration/Version.defs | 4 +- .../Graphics/GraphWPF/DrawPixels.pas | 9 +++ ReleaseGenerators/PascalABCNET_version.nsh | 2 +- SyntaxVisitors/SugarVisitors/TupleVisitor.cs | 2 +- TestSuite/CompilationSamples/GraphWPF.pas | 69 ++++++++++++------- TestSuite/errors/err0319.pas | 6 -- TestSuite/lambda_capture_local_vs_field.pas | 24 ------- TestSuite/lambda_nonstatic_from_static.pas | 24 ------- VisualPascalABCNET/UserOptions.cs | 2 +- bin/Lib/GraphWPF.pas | 32 ++++----- 11 files changed, 74 insertions(+), 102 deletions(-) create mode 100644 InstallerSamples/Graphics/GraphWPF/DrawPixels.pas delete mode 100644 TestSuite/errors/err0319.pas delete mode 100644 TestSuite/lambda_capture_local_vs_field.pas delete mode 100644 TestSuite/lambda_nonstatic_from_static.pas diff --git a/Configuration/GlobalAssemblyInfo.cs b/Configuration/GlobalAssemblyInfo.cs index 4f80826c0..e964cad6f 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 = "4"; public const string Build = "2"; - public const string Revision = "2050"; + public const string Revision = "2055"; 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 090031ed1..d3c2b562a 100644 --- a/Configuration/Version.defs +++ b/Configuration/Version.defs @@ -1,4 +1,4 @@ -%COREVERSION%=2 -%REVISION%=2050 %MINOR%=4 +%REVISION%=2055 +%COREVERSION%=2 %MAJOR%=3 diff --git a/InstallerSamples/Graphics/GraphWPF/DrawPixels.pas b/InstallerSamples/Graphics/GraphWPF/DrawPixels.pas new file mode 100644 index 000000000..ae64a9877 --- /dev/null +++ b/InstallerSamples/Graphics/GraphWPF/DrawPixels.pas @@ -0,0 +1,9 @@ +uses GraphWPF; + +begin + Window.SetSize(640, 480); + var m := MatrGen(640,480,(x,y)->RGB(2 * x - y, x - 3 * y, x + y)); + MillisecondsDelta.Println; + DrawPixels(0,0,m); + MillisecondsDelta.Println; +end. \ No newline at end of file diff --git a/ReleaseGenerators/PascalABCNET_version.nsh b/ReleaseGenerators/PascalABCNET_version.nsh index c8c892130..3ff4752bd 100644 --- a/ReleaseGenerators/PascalABCNET_version.nsh +++ b/ReleaseGenerators/PascalABCNET_version.nsh @@ -1 +1 @@ -!define VERSION '3.4.2.2050' +!define VERSION '3.4.2.2055' diff --git a/SyntaxVisitors/SugarVisitors/TupleVisitor.cs b/SyntaxVisitors/SugarVisitors/TupleVisitor.cs index 31120ef49..77bfb12cb 100644 --- a/SyntaxVisitors/SugarVisitors/TupleVisitor.cs +++ b/SyntaxVisitors/SugarVisitors/TupleVisitor.cs @@ -39,7 +39,7 @@ namespace SyntaxVisitors.SugarVisitors public override void visit(tuple_node tup) { - var dn = new dot_node(new dot_node(new ident("?System"), new ident("Tuple")), new ident("Create", tup.source_context)); + var dn = new dot_node(new dot_node(new ident("?System", tup.source_context), new ident("Tuple", tup.source_context), tup.source_context), new ident("Create", tup.source_context)); var mc = new method_call(dn, tup.el, tup.source_context); //var sug = new sugared_expression(tup, mc, tup.source_context); - нет никакой семантической проверки - всё - на уровне синтаксиса! diff --git a/TestSuite/CompilationSamples/GraphWPF.pas b/TestSuite/CompilationSamples/GraphWPF.pas index 8a99d0352..4459e3ea6 100644 --- a/TestSuite/CompilationSamples/GraphWPF.pas +++ b/TestSuite/CompilationSamples/GraphWPF.pas @@ -200,11 +200,13 @@ type //>> Графические примитивы # GraphWPF primitives // ----------------------------------------------------- /// Рисует пиксел в точке (x,y) цветом c -procedure SetPixels(x,y: real; w,h: integer; f: (integer,integer)->Color); -/// Рисует пиксел в точке (x,y) цветом c procedure SetPixel(x,y: real; c: Color); -/// Рисует двумерный массив пикселов с координатами левой верхней вершины (x,y) -procedure DrawPixels(x,y: real; a: array [,] of Color); +/// Рисует прямоугольник пикселей размера (w,h), задаваемых отображением f, начиная с левого верхнего угла с координатами (x,y) +procedure SetPixels(x,y: real; w,h: integer; f: (integer,integer)->Color); +/// Рисует двумерный массив пикселей pixels начиная с левого верхнего угла с координатами (x,y) +procedure DrawPixels(x,y: real; pixels: array [,] of Color); +/// Рисует прямоугольную область (px,py,pw,ph) двумерного массива пикселей pixels начиная с левого верхнего угла с координатами (x,y) +procedure DrawPixels(x,y: real; pixels: array [,] of Color; px,py,pw,ph: integer); /// Рисует эллипс с центром в точке (x,y) и радиусами rx и ry procedure Ellipse(x,y,rx,ry: real); /// Рисует контур эллипса с центром в точке (x,y) и радиусами rx и ry @@ -767,32 +769,45 @@ begin Result := dpic[fname]; end; -procedure DrawPixelsP(x,y: real; a: array [,] of Color); +procedure DrawPixelsP(x,y:real; px,py,pw,ph: integer; a: array [,] of Color); begin var (scalex,scaley) := ScaleToDevice; - var sw := a.ColCount; - var sh := a.RowCount; - var bitmap := new WriteableBitmap(sw, sh, 96*scalex, 96*scaley, PixelFormats.Bgra32, nil); - var stride := sw * (bitmap.Format.BitsPerPixel div 8); // stride - это длина одной строки + var bitmap := new WriteableBitmap(pw, ph, 96*scalex, 96*scaley, PixelFormats.Bgra32, nil); - var pixels := new byte[a.RowCount*a.ColCount*4]; - var p := 0; - for var i := 0 to a.RowCount-1 do - for var j := 0 to a.ColCount-1 do - begin - pixels[p] := a[i,j].B; - p += 1; - pixels[p] := a[i,j].G; - p += 1; - pixels[p] := a[i,j].R; - p += 1; - pixels[p] := a[i,j].A; - p += 1; - end; - bitmap.WritePixels(new Int32Rect(0, 0, sw, sh), pixels, stride, 0); + var stride := pw*4; // stride - это размер одной строки в байтах + var size := stride*ph; + + +// var pixels := new byte[w*h*4]; +// var p := 0; +// for var dy := ay to ay+h-1 do +// for var dx := ax to ax+w-1 do +// begin +// pixels[p] := a[dx,dy].B; p += 1; +// pixels[p] := a[dx,dy].G; p += 1; +// pixels[p] := a[dx,dy].R; p += 1; +// pixels[p] := a[dx,dy].A; p += 1; +// end; +// bitmap.WritePixels(new Int32Rect(0, 0, w, h), pixels, stride, 0); + + + //так на 10-20% быстрее + var pixels := System.Runtime.InteropServices.Marshal.AllocHGlobal(size); + var curr_ptr := pixels; + for var dy := py to py+ph-1 do + for var dx := px to px+pw-1 do + begin + var c := a[dx,dy]; + PByte(curr_ptr.ToPointer)^ := c.B; curr_ptr := curr_ptr + 1; + PByte(curr_ptr.ToPointer)^ := c.G; curr_ptr := curr_ptr + 1; + PByte(curr_ptr.ToPointer)^ := c.R; curr_ptr := curr_ptr + 1; + PByte(curr_ptr.ToPointer)^ := c.A; curr_ptr := curr_ptr + 1; + end; + bitmap.WritePixels(new Int32Rect(0, 0, pw, ph), pixels, size, stride); + System.Runtime.InteropServices.Marshal.FreeHGlobal(pixels); var dc := GetDC(); - dc.DrawImage(bitmap, Rect(x, y, bitmap.PixelWidth, bitmap.PixelHeight)); + dc.DrawImage(bitmap, Rect(x, y, pw, ph)); ReleaseDC(dc); end; @@ -915,7 +930,9 @@ procedure SetPixel(x,y: real; c: Color) := InvokeVisual(SetPixelP, x, y, c); procedure SetPixels(x,y: real; w,h: integer; f: (integer,integer)->Color) := InvokeVisual(SetPixelsP, x, y, w, h, f); -procedure DrawPixels(x,y: real; a: array [,] of Color) := InvokeVisual(DrawPixelsP,x,y,a); +procedure DrawPixels(x,y: real; pixels: array [,] of Color) := InvokeVisual(DrawPixelsP,x,y,0,0,pixels.GetLength(0),pixels.GetLength(1),pixels); + +procedure DrawPixels(x,y: real; pixels: array [,] of Color; px,py,pw,ph: integer) := InvokeVisual(DrawPixelsP,x,y,px,py,pw,ph,pixels); procedure ArcPFull(x, y, r, angle1, angle2: real; p: GPen) := ArcSectorPFull(x, y, r, angle1, angle2, nil, p, false); diff --git a/TestSuite/errors/err0319.pas b/TestSuite/errors/err0319.pas deleted file mode 100644 index fa7ae10be..000000000 --- a/TestSuite/errors/err0319.pas +++ /dev/null @@ -1,6 +0,0 @@ -type AAA = record s: string[4] end; - -begin - var f := OpenFile&('a.dat'); - //f.Read; -end. \ No newline at end of file diff --git a/TestSuite/lambda_capture_local_vs_field.pas b/TestSuite/lambda_capture_local_vs_field.pas deleted file mode 100644 index 36cf9c8b8..000000000 --- a/TestSuite/lambda_capture_local_vs_field.pas +++ /dev/null @@ -1,24 +0,0 @@ -type - t1 = class - - static a: integer := 1;//не обязательно статичное поле - - procedure p1; - begin - var a := 2; - var p: procedure := ()->begin - - Assert(a=2); - - end; - - p; - end; - - end; - -begin - - (new t1).p1; - -end. \ No newline at end of file diff --git a/TestSuite/lambda_nonstatic_from_static.pas b/TestSuite/lambda_nonstatic_from_static.pas deleted file mode 100644 index c94beadfe..000000000 --- a/TestSuite/lambda_nonstatic_from_static.pas +++ /dev/null @@ -1,24 +0,0 @@ -type - t1 = class - - b: byte; - - static procedure p1(b: byte); - begin - - var p: procedure; - p := ()-> - begin - p := ()-> - begin - b := b; - end; - end; - - end; - - end; - -begin - Assert(1=1); -end. \ No newline at end of file diff --git a/VisualPascalABCNET/UserOptions.cs b/VisualPascalABCNET/UserOptions.cs index 7a64d6b30..e44bb595b 100644 --- a/VisualPascalABCNET/UserOptions.cs +++ b/VisualPascalABCNET/UserOptions.cs @@ -13,7 +13,7 @@ namespace VisualPascalABC public bool EnableFolding = false; // SSM 4.09.08 public bool ShowMathBraket = false; public bool ConverTabsToSpaces = true; - public bool deleteEXEAfterExecute = true; + public bool deleteEXEAfterExecute = false; public bool deletePDBAfterExecute = true; public bool UseOutputDirectory = false; public string OutputDirectory = null; diff --git a/bin/Lib/GraphWPF.pas b/bin/Lib/GraphWPF.pas index f72c1cf41..6baed01fa 100644 --- a/bin/Lib/GraphWPF.pas +++ b/bin/Lib/GraphWPF.pas @@ -200,13 +200,13 @@ type //>> Графические примитивы # GraphWPF primitives // ----------------------------------------------------- /// Рисует пиксел в точке (x,y) цветом c -procedure SetPixels(x,y: real; w,h: integer; f: (integer,integer)->Color); -/// Рисует пиксел в точке (x,y) цветом c procedure SetPixel(x,y: real; c: Color); -/// Рисует двумерный массив пикселей, левым верхнум углом на координатах окна (x;y) -procedure DrawPixels(x,y: real; a: array [,] of Color); -/// Рисует прямоугольную область (ax;ay;w;h) из двумерного массива пикселей, левым верхнум углом на координатах окна (x;y) -procedure DrawPixels(x,y: real; ax,ay, w,h: integer; a: array [,] of Color); +/// Рисует прямоугольник пикселей размера (w,h), задаваемых отображением f, начиная с левого верхнего угла с координатами (x,y) +procedure SetPixels(x,y: real; w,h: integer; f: (integer,integer)->Color); +/// Рисует двумерный массив пикселей pixels начиная с левого верхнего угла с координатами (x,y) +procedure DrawPixels(x,y: real; pixels: array [,] of Color); +/// Рисует прямоугольную область (px,py,pw,ph) двумерного массива пикселей pixels начиная с левого верхнего угла с координатами (x,y) +procedure DrawPixels(x,y: real; pixels: array [,] of Color; px,py,pw,ph: integer); /// Рисует эллипс с центром в точке (x,y) и радиусами rx и ry procedure Ellipse(x,y,rx,ry: real); /// Рисует контур эллипса с центром в точке (x,y) и радиусами rx и ry @@ -769,13 +769,13 @@ begin Result := dpic[fname]; end; -procedure DrawPixelsP(x,y:real; ax,ay, w,h: integer; a: array [,] of Color); +procedure DrawPixelsP(x,y:real; px,py,pw,ph: integer; a: array [,] of Color); begin var (scalex,scaley) := ScaleToDevice; - var bitmap := new WriteableBitmap(w, h, 96*scalex, 96*scaley, PixelFormats.Bgra32, nil); + var bitmap := new WriteableBitmap(pw, ph, 96*scalex, 96*scaley, PixelFormats.Bgra32, nil); - var stride := w*4; // stride - это размер одной строки в байтах - var size := stride*h; + var stride := pw*4; // stride - это размер одной строки в байтах + var size := stride*ph; // var pixels := new byte[w*h*4]; @@ -794,8 +794,8 @@ begin //так на 10-20% быстрее var pixels := System.Runtime.InteropServices.Marshal.AllocHGlobal(size); var curr_ptr := pixels; - for var dy := ay to ay+h-1 do - for var dx := ax to ax+w-1 do + for var dy := py to py+ph-1 do + for var dx := px to px+pw-1 do begin var c := a[dx,dy]; PByte(curr_ptr.ToPointer)^ := c.B; curr_ptr := curr_ptr + 1; @@ -803,11 +803,11 @@ begin PByte(curr_ptr.ToPointer)^ := c.R; curr_ptr := curr_ptr + 1; PByte(curr_ptr.ToPointer)^ := c.A; curr_ptr := curr_ptr + 1; end; - bitmap.WritePixels(new Int32Rect(0, 0, w, h), pixels, size, stride); + bitmap.WritePixels(new Int32Rect(0, 0, pw, ph), pixels, size, stride); System.Runtime.InteropServices.Marshal.FreeHGlobal(pixels); var dc := GetDC(); - dc.DrawImage(bitmap, Rect(x, y, w, h)); + dc.DrawImage(bitmap, Rect(x, y, pw, ph)); ReleaseDC(dc); end; @@ -930,9 +930,9 @@ procedure SetPixel(x,y: real; c: Color) := InvokeVisual(SetPixelP, x, y, c); procedure SetPixels(x,y: real; w,h: integer; f: (integer,integer)->Color) := InvokeVisual(SetPixelsP, x, y, w, h, f); -procedure DrawPixels(x,y: real; a: array [,] of Color) := InvokeVisual(DrawPixelsP,x,y,0,0,a.GetLength(0),a.GetLength(1),a); +procedure DrawPixels(x,y: real; pixels: array [,] of Color) := InvokeVisual(DrawPixelsP,x,y,0,0,pixels.GetLength(0),pixels.GetLength(1),pixels); -procedure DrawPixels(x,y: real; ax,ay, w,h: integer; a: array [,] of Color) := InvokeVisual(DrawPixelsP,x,y,ax,ay,w,h,a); +procedure DrawPixels(x,y: real; pixels: array [,] of Color; px,py,pw,ph: integer) := InvokeVisual(DrawPixelsP,x,y,px,py,pw,ph,pixels); procedure ArcPFull(x, y, r, angle1, angle2: real; p: GPen) := ArcSectorPFull(x, y, r, angle1, angle2, nil, p, false);