unit u_scope;

{$mode objfpc}{$H+}

interface

uses
 Classes, SysUtils, Forms, Controls, Graphics,  Dialogs,
  ExtCtrls, Buttons;

type
  tTrace = array of integer;
  tScope = class
    procedure Init (Form:tForm; Left, Top, Xdivs, Ydivs, XPixperDiv, YpixPerDiv, GridColor: integer);
    procedure MoveTo (X, Y: real);
    procedure LineTo (X, Y: real; Color: integer);
    procedure MoveToXY (X, Y: real);
    procedure LineToXY (X, Y: real; Color: integer);
    procedure PlotBox (X, Y: real; Size, Color: integer);
    procedure PlotBoxXY (X, Y: real; Size, Color: integer);
    procedure PlotCircle (X, Y:real; Radius: real; Color:integer);
    procedure PlotCircleXY (X, Y, Radius: real; Color:integer);
    procedure PlotVectorXY (X, Y: real; Color:integer);
    procedure PlotTrace (Trace: tTrace; Color: integer);
    procedure ReDraw;
    procedure WriteText (X, Y: real; Txt: shortstring);
    procedure SaveImageToFile (ToFileName: shortstring);
    private
      sc_Form: tForm;
      sc_GridColor,
      sc_Margin,
      sc_XDivs, sc_YDivs,
      sc_XPixPerDiv, sc_YPixPerDiv: integer;
    public
      sc_Left, sc_Right, sc_Top, sc_Bottom: integer;   // limits of graph area absolute
      sc_Width, sc_Height: integer;  // witdh and height of graph area
      sc_HalfWidth, sc_HalfHeight: integer;  // witdh and height of graph area
      sc_MidX, sc_MidY: real;  // absolute
    end;

// How to use this class
// In a var block put: Your_Scope: tScope;
// In the FormCreate event handler put: Your_Scope:= tScope.create;
// Before actually using it do: Your_Scope.Init (YourForm, ........) Do NOT call this
// from FrmMain.FormCreate.
// Remind: Top, Left is now the display area. The red margin is outward offsetted.
// Increasing X goes from Left to Right
// Increasing Y goes from Bottom to Top within the graph
// Increasing Y goes from Top to Bottom for the graph's vertical positon.

// ChangeLog
// 2024-03-27: Made X, Y and Radius parameters real. MidX, MidY accessible and real
// 2024-03-28: added PlotVectorXY   from center to [X,Y]
// 2024-04-10: added tPaintBox, fixed several offsets
// 2024-05-30: removed tPaintBox, superfluous
// 2024-08-25: reworked for Top-Left gives display area. Fixed several bugs
// 2024-12-23: added text field
// 2024-12-25: added clipping (not tested in all situations)
// 2025-02-22: added PlotTrace
// 2025-03-27: repaired a smal error in SaveImageToFile

implementation

// All dimensions are in pixels

function LimitMax (V, Limit: integer) : integer;
begin
  LimitMax:= V;
  if V > Limit then LimitMax:= Limit;
end;

function LimitMin (V, Limit: integer) : integer;
begin
  LimitMin:= V;
  if V < Limit then LimitMin:= Limit;
end;

procedure tScope.PlotTrace (Trace: tTrace; Color: integer);
var
  X, Y: integer;
begin
  with sc_Form.Canvas do
  begin
    Pen.Color:= Color;
    Pen.Style:= psSolid;
    for X:= 0 to sc_Width do
    begin
      Y:= round (Trace[X]);
      // clip the graph
      if Y < -sc_HalfHeight Then Y:= -sc_HalfHeight;
      if Y > sc_HalfHeight Then Y:= sc_HalfHeight;
      if X = 0 then Moveto (X + 5, sc_HalfHeight + 5 - Y) else Lineto (X + 5, sc_HalfHeight + 5 - Y);
    end;
  end;
end;

procedure tScope.WriteText (X, Y: real; Txt: shortstring);
begin
  with sc_form.canvas do
  begin
    //SetTextStyle (ScriptFont, HorizDir, 10);
    font.color:= clWhite;
    font.size:= 10;
    Textout (round (X), round (Y), Txt);
  end;
end;

procedure tScope.MoveTo (X, Y: real);
// X zero = Left, Y zero = midscale
var XX, YY: integer;
begin
  XX:= round (sc_Left + X); // X from left
  YY:= round (sc_MidY - Y); // Y zero = mid
  // clip the graph
  YY:= LimitMin (YY, sc_Top);
  YY:= LimitMax (YY, sc_Bottom);
  XX:= LimitMax (XX, sc_Right);
  XX:= LimitMin (XX, sc_Left);
  sc_Form.canvas.moveto (XX, YY);
end;

procedure tScope.LineTo (X, Y: real; Color: integer);
// X zero = Left, Y zero = midscale
var XX, YY: integer;
begin
  sc_Form.canvas.Pen.Color:= Color;
  XX:= round (sc_Left + X); // X from left
  YY:= round (sc_MidY - Y); // Y zero = mid
  // clip the graph
  YY:= LimitMin (YY, sc_Top);
  YY:= LimitMax (YY, sc_Bottom);
  XX:= LimitMax (XX, sc_Right);
  Xx:= LimitMin (XX, sc_Left);
  sc_Form.canvas.lineto (XX,YY);
end;

procedure tScope.MoveToXY (X, Y: real);
// X zero = midscale, Y zero = midscale
var XX, YY: integer;
begin
  XX:= round (sc_MidX + X);  // center
  YY:= round (sc_MidY - Y);
  // clip the graph
  YY:= LimitMin (YY, sc_Top);
  YY:= LimitMax (YY, sc_Bottom);
  XX:= LimitMax (XX, sc_Right);
  Xx:= LimitMin (XX, sc_Left);
  sc_Form.canvas.moveto (XX, YY);
end;

procedure tScope.LineToXY (X, Y: real; Color: integer);
// X zero = midscale, Y zero = midscale
var XX, YY: integer;
begin
  sc_Form.canvas.Pen.Color:= Color;
  XX:= round (sc_MidX + X);
  YY:= round (sc_MidY - Y);
  // clip the graph
  YY:= LimitMin (YY, sc_Top);
  YY:= LimitMax (YY, sc_Bottom);
  XX:= LimitMax (XX, sc_Right);
  XX:= LimitMin (XX, sc_Left);
  sc_Form.canvas.lineto (XX, YY);
end;

procedure tScope.PlotCircle (X, Y:real; Radius: real; Color:integer);
var
  I, XX, YY: integer;
const N = 100;
begin
  X:= sc_Left + X;  // left
  Y:= sc_Top + sc_Height - Y;
  with sc_Form.Canvas do
  begin
    Pen.Color:= Color;
    XX:= LimitMax (round (X + radius), sc_Right);
    XX:= LimitMin (round (X - radius), sc_Left);
    MoveTo (XX, round (Y)); //phi = 0
    for I:= 0 to N do
    begin
      XX:= round (X + cos (I / N * pi * 2) * radius);
      YY:= round (Y - sin (I / N * pi * 2) * radius);
       // clip the graph
      YY:= LimitMin (YY, sc_Top);
      YY:= LimitMax (YY, sc_Bottom);
      XX:= LimitMax (XX, sc_Right);
      XX:= LimitMin (XX, sc_Left);
      lineto (XX, YY);
    end;
  end;
end;

procedure tScope.PlotCircleXY (X, Y:real; Radius: real; Color:integer);
var
  I, XX, YY: integer;
const N = 100;
begin
  X:= sc_MidX + X;  // center
  Y:= sc_MidY - Y;
  with sc_Form.Canvas do
  begin
    Pen.Color:= Color;
    XX:= round (X + radius);
    YY:= round (Y);
    //XX:= LimitMax (round (X + radius), sc_Right);
    //XX:= LimitMin (round (X - radius), sc_Left);
    //YY:= LimitMax (round (Y - radius), sc_Bottom);
    //YY:= LimitMin (round (Y + radius), sc_Top);
    MoveTo (XX, YY); // angle = 0
    for I:= 0 to N do
    begin
      XX:= round (X + cos (I / N * pi * 2) * radius);
      YY:= round (Y - sin (I / N * pi * 2) * radius);
      // clip the graph
      XX:= LimitMax (XX, sc_Right);
      XX:= LimitMin (XX, sc_Left);
      YY:= LimitMax (YY, sc_Bottom);
      YY:= LimitMin (YY, sc_Top);
      lineto (XX, YY);
    end;
  end;
end;

procedure tScope.PlotBox (X, Y: real; Size, Color: integer);
// X zero = Left, Y zero = midscale
var XX, YY: integer;
begin
  sc_Form.canvas.Pen.Color:= Color;
  XX:= round (sc_Left + X);
  YY:= round (sc_MidY - Y);
  sc_Form.canvas.rectangle (XX - Size, YY - Size, XX + Size, YY + Size);
end;

procedure tScope.PlotBoxXY (X, Y: real; Size, Color: integer);
// X zero = midscale, Y zero = midscale
var XX, YY: integer;
begin
  XX:= round (sc_MidX + X);
  YY:= round (sc_MidY - Y);
  sc_Form.canvas.Pen.Color:= Color;
  sc_Form.canvas.rectangle
    (XX-Size, YY - Size, XX + Size, YY + Size);
end;

procedure tScope.PlotVectorXY (X, Y: real; Color:integer);
// X zero = midscale, Y zero = midscale
var XX, YY: integer;
begin
  XX:= round (sc_MidX + X);
  YY:= round (sc_MidY - Y);
  with sc_Form.Canvas do
  begin
    Pen.Color:= Color;
    // clip the graph
    YY:= LimitMin (YY, sc_Top);
    YY:= LimitMax (YY, sc_Bottom);
    XX:= LimitMax (XX, sc_Right);
    XX:= LimitMin (XX, sc_Left);
    MoveTo (round (sc_MidX), round (sc_MidY));
    Lineto (XX, YY);
  end;
end;

procedure tScope.SaveImageToFile (ToFileName: shortstring);
var
  RectangleFrom, RectangleTo: tRect;
  myPNG: TportableNetworkGraphic; // .PNG file
  TwoMargin: integer;
begin
  with sc_Form.Canvas do
  begin
    TwoMargin:= 2 * sc_Margin;
    // rectangleFrom:= rect (left, bottom, right, top);
    RectangleFrom:= rect (sc_Left-sc_Margin, sc_Top-sc_Margin, sc_Left + sc_Width + sc_Margin, sc_Top + sc_Height + sc_Margin);
    // rectangleTo:= rect (0, 0, right-left + 1, top-bottom + 1);
    RectangleTo:= rect (0, 0, sc_Width + TwoMargin+1, sc_Height + TwoMargin + 1);
    myPNG:= tPortableNetworkGraphic.create;
    myPNG.width:= sc_Width + TwoMargin + 1;
    myPNG.height:= sc_Height + TwoMargin + 1;
    myPNG.canvas.copyRect (rectangleTo, sc_Form.Canvas, rectangleFrom);
    myPNG.SaveToFile (toFileName + '.PNG');
    myPNG.free;
  end;
end;

procedure tScope.ReDraw;
var i, X, Y: integer;
begin
  with sc_Form.Canvas do
  begin
    Pen.Style:= psSolid;
    Pen.Color:= sc_GridColor;
    Brush.Color:= clBlack;
    AutoReDraw:= true;
    rectangle (sc_Left, sc_Top, sc_Left + sc_Width, sc_Top + sc_Height);
    For i:= 0 To sc_XDivs do // vertical lines
    begin
      //if i = (sc_Xdivs div 2) then pen.width:= 2 else pen.width:= 1;
      X:= sc_left + i * sc_XPixPerDiv;
      Line (X, sc_Top , X, sc_Top + sc_Height);
    end;
    For i:= 0 To sc_YDivs do //  horizontal lines
    begin
      if i = (sc_YDivs div 2) then pen.width:= 2 else pen.width:= 1;
      Y:= sc_Top + i * sc_YPixPerDiv;
      Line (sc_Left, Y, sc_Left + sc_Width, Y);
    end;
  end;
end;

procedure tScope.Init (Form: tForm; Left, Top, Xdivs, Ydivs, XPixperDiv, YpixPerDiv, GridColor: integer);
begin
  sc_Form:= Form;
  sc_GridColor:= GridColor;
  sc_Margin:= 5;
  sc_Top:= Top;   // abs pos of display area
  sc_Left:= Left;
  sc_XDivs:= Xdivs;
  sc_YDivs:= Ydivs;
  sc_XPixPerDiv:= XPixPerDiv;
  sc_YPixPerDiv:= YPixPerDiv;
  sc_Width:= sc_Xdivs * XPixPerDiv;  // Display area X
  sc_HalfWidth:= sc_Width div 2;
  sc_Right:= sc_Left + sc_Width;
  sc_Height:= sc_YDivs * YPixPerDiv;  // Display area Y
  sc_Halfheight:= sc_Height div 2;
  sc_Bottom:= sc_Top + sc_Height;     // abs
  sc_MidX:= sc_Left + sc_Width div 2; // abs
  sc_MidY:= sc_Top + sc_Height div 2; // abs
  with sc_Form.canvas do
  begin
    Brush.Color:= clBlack;
    Pen.Color:= clRed;
    Pen.Style:= psSolid;
    AutoReDraw:= true;
    rectangle (sc_Left-sc_Margin, sc_Top-sc_Margin, sc_Left + sc_Width + sc_Margin, sc_Top + sc_Height + sc_Margin);
  end;
  ReDraw;
  // for diagnose
  //if true then MemoCommentsAdd (format ('L:%4d R:%4d T:%4d B:%4d MX:%4.0f MY:%4.0f',
  //[sc_Left, sc_Right, sc_Top, sc_Bottom, sc_MidX, sc_MidY]));
end;

end.
