unit u_compass;

// Purpose: Handles Compass display (polar)

{$mode objfpc}{$H+}

interface

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

type
  tCompass = class
    // Angles are in degrees
    // Distances are in pixels
    procedure Init (Form: tForm; X, Y, Size: integer);
    procedure DrawCircle (r, Color: integer);
    procedure DrawCircle (XX, YY, r, Color:integer);
    procedure PlotPoint (X, Y, Color: integer);
    procedure PlotPoint (X, Y, Size, Color: integer);
    procedure PlotBox (X, Y, Size, Color: integer);
    procedure PlotFilledBox (X, Y, Size, Color: integer);
    procedure PlotPixel (X, Y, Color: integer);
    procedure DrawVectorTip (Angle: real; rTip: real; Color:integer);
    procedure DrawRadialLine (Angle: real; rStart, rStop: real; Color:integer);
    procedure PlotAngleMarker (Angle: real; Color:integer);
    procedure TextLowerLeft (Txt: shortstring);
    procedure SaveImageToFile (ToFileName: string);
    procedure Redraw;
    private
      const TwoPi = 2 * pi;
      var
        c_Form: Tform;
        c_Left: integer; // All dimensions in pixels
        c_Top: integer;
        c_Size: integer;
        c_Center_X: integer;
        c_Center_Y: integer;
     public
        { public declarations }
    end;

// How to use this class
// In a var block put: Your_Compass: tCompass;
// In the FormCreate event handler put: Your_Compass:= tCompass.create;
// Before actually using it do: Your_Compass.Init (YourForm, ........) Do NOT call this
// from FrmMain.FormCreate.

// ChangeLog
// 2025-02-23:
//   added "How to use this class".
//   moved instanciating out of this unit.

procedure Rotate (X, Y, Angle : real; var Xrotated, Yrotated: real);

implementation

procedure tCompass.TextLowerLeft (Txt: shortstring);
begin
  with c_Form.canvas do
  begin
    font.color:= clWhite;
    font.size:= 10;
    Textout (c_Left + 2, c_Top + 2, Txt);
  end;
end;

procedure tCompass.SaveImageToFile (ToFileName: string);
var
  RectangleFrom, RectangleTo: tRect;
  myPNG: TportableNetworkGraphic; // .PNG file
begin
  with c_Form.Canvas do
  begin
    //rectangleFrom:=rect (left, bottom, right, top);
    RectangleFrom:= rect (c_left, c_Top, c_Left+c_Size, c_Top+c_Size);
    //rectangleTo:=rect (0,0,right-left+1,top-bottom+1);
    RectangleTo:= rect (0, 0, c_Size+1, c_Size+1);
    myPNG:= tPortableNetworkGraphic.create;
    myPNG.width:= c_Size+1;
    myPNG.height:= c_Size+1;
    myPNG.canvas.copyRect (rectangleTo, c_Form.Canvas, rectangleFrom);
    myPNG.SaveToFile (toFileName + '.PNG');
    myPNG.free;
  end;
end;

procedure Rotate (X, Y, Angle : real; var Xrotated, Yrotated: real);
var CosAngle, SinAngle: real;
begin
  CosAngle:= cos (Angle);
  SinAngle:= sin (Angle);
  Xrotated:= X * CosAngle - Y * SinAngle;
  Yrotated:= X * SinAngle + Y * CosAngle;
end;

procedure tCompass.Init (Form: tForm; X, Y, Size: integer);
begin
  c_Form:= Form;
  c_Left:= X;
  c_Top:= Y;
  c_Size:= Size;
  c_Center_X:= c_Left + Size div 2;
  c_Center_Y:= c_Top + Size div 2;
  With c_Form.Canvas do
  begin
    Brush.Color:= clBlack;
    Pen.Color:= clWhite;
    AutoReDraw:= true;
    Pen.Style:= psSolid;
    Rectangle (c_Left, c_Top, c_left + c_Size, c_Top + c_Size);
    Redraw;
  end;
end;

procedure tCompass.DrawCircle (r, Color: integer);
var
  I: integer;
  X, Y: real;
const N = 100;
begin
  with c_Form.canvas do
  begin
    Pen.Color:= Color;
    MoveTo (c_Center_X + r, c_Center_Y);
    for I:= 0 to N do
    begin
      X:= cos (I / N * TwoPi) * r;
      Y:= sin (I / N * TwoPi) * r;
      lineto (c_Center_X + round (X), c_Center_Y - round (Y));
    end;
  end;
end;

procedure tCompass.DrawCircle (XX, YY, r, Color:integer);
var
  I: integer;
  X, Y: real;
const N = 100;
begin
  with c_Form.Canvas do
  begin
    Pen.Color:= Color;
    MoveTo (c_Center_X + r + XX, c_Center_Y - YY);
    for I:= 0 to N do
    begin
      X:= cos (I / N * TwoPi) * r + XX;
      Y:= sin (I / N * TwoPi) * r + YY;
      lineto (c_Center_X + round (X), c_Center_Y - round (Y));
    end;
  end;
end;

procedure tCompass.PlotPixel (X, Y, Color: integer);
begin
  c_Form.canvas.Pen.Color:= Color;
  c_Form.canvas.line (c_Center_X + X, c_Center_Y - Y, c_Center_X + X, c_Center_Y - Y);
end;

procedure tCompass.PlotPoint (X, Y, Color: integer);
begin
  c_Form.canvas.Pen.Color:= Color;
  c_Form.canvas.rectangle
    (c_Center_X + X - 2, c_Center_Y - Y - 2,
     c_Center_X + X + 2, c_Center_Y - Y + 2);
end;

procedure tCompass.PlotPoint (X, Y, Size, Color: integer);
begin
  c_Form.canvas.Pen.Color:= Color;
  c_Form.canvas.rectangle
    (c_Center_X + X - Size, c_Center_Y - Y - Size,
     c_Center_X + X + Size, c_Center_Y - Y + Size);
end;

procedure tCompass.PlotBox (X, Y, Size, Color: integer);
begin
  c_Form.canvas.Pen.Color:= Color;
  c_Form.canvas.line (c_Center_X - X + Size, c_Center_Y - Y + Size,
                      c_Center_X - X - Size, c_Center_Y - Y - Size);
  c_Form.canvas.line (c_Center_X - X + Size, c_Center_Y - Y - Size,
                      c_Center_X - X - Size, c_Center_Y - Y + Size);
  c_Form.canvas.rectangle
    (c_Center_X + X - Size, c_Center_Y - Y + Size,
     c_Center_X + X + Size, c_Center_Y - Y - Size);
end;

procedure tCompass.PlotFilledBox (X, Y, Size, Color: integer);
var i: integer;
begin
  c_Form.canvas.Pen.Color:= Color;
  // draw concentric rectangles
  for i:= Size downto 0 do // Upto gives hollow boxes
    c_Form.canvas.rectangle
      (c_Center_X + X - i, c_Center_Y - Y + i,
       c_Center_X + X + i, c_Center_Y - Y - i);
end;

procedure tCompass.DrawVectorTip (Angle: real; rTip: real; Color:integer);
var Sine, Cosine: real;
begin
  with c_Form.canvas do
  begin
    Cosine:= cos (Angle);
    Sine:= sin (Angle);
    Pen.Color:= Color;
    Line
      (c_Center_X,
       c_Center_Y,
       c_Center_X + round (rTip * Cosine),
       c_Center_Y - round (rTip * Sine));
  end;
end;

procedure tCompass.DrawRadialLine (Angle: real; rStart, rStop: real; Color:integer);
var Sine, Cosine: real;
begin
  with c_Form.canvas do
  begin
    Cosine:= cos (Angle);
    Sine:= sin (Angle);
    Pen.Color:= Color;
    Line
      (c_Center_X + round(rStart * Cosine),
       c_Center_Y - round(rStart * Sine),
       c_Center_X + round(rStop * Cosine),
       c_Center_Y - round(rStop * Sine));
  end;
end;

procedure tCompass.PlotAngleMarker (Angle: real; Color:integer);
var X, Y: integer;
begin
  X:= round(160 * cos (Angle * pi / 180));
  Y:= round(160 * sin (Angle * pi / 180));
  c_Form.canvas.Pen.Color:= Color;
  DrawCircle (X, Y, 4, Color);
end;

procedure tCompass.Redraw;
const GridColor= $007700; // dark green
var I: integer;
begin
  c_Form.Canvas.Pen.Style:= psSolid;
  DrawCircle (4, GridColor);
  DrawCircle (32, GridColor);
  DrawCircle (64, GridColor);
  DrawCircle (96, GridColor);
  DrawCircle (128, GridColor);
  DrawCircle (160, clWhite);
  for I:= 0 to 15 do
    DrawRadialLine (I / 16 * TwoPi, 32, 160, GridColor);
  DrawRadialLine (0 * TwoPi, 4, 32, GridColor);
  DrawRadialLine (4 * TwoPi / 16, 4, 32, GridColor);
  DrawRadialLine (8 * TwoPi / 16, 4, 32, GridColor);
  DrawRadialLine (12 * TwoPi / 16 , 4, 32, GridColor);
end;

begin
// no unit initialisation code
end.

