{ Testing  xVectRN.pp
  See comments in this unit.
  --------------------------------------------}
program tEx059;

// To tell FreePascal that the application is a Graphical User Interface
// i.e. is running in windows, not in text mode.
{$APPTYPE GUI}

Uses

  wApplication0
 ,wWindow0
 ,xVectRN
 ,tEx059Unit // To do some test with the assignment operator.
 ,wGlobals2
 ,wDebug0
 ,Windows;

type
  PMyWindow = ^TMyWindow;
  TMyWindow = object(TWindow)
  //"""""""""""""""""""""""""

  constructor Init(strWinTitlePrm:ShortString);
  destructor Done; virtual;

  procedure Test1;
  procedure Test2;
  procedure Test3;
  procedure Test4;

  function WMCommand(wPar:WPARAM; lPar:LPARAM):LRESULT; virtual;
  // Handles the menu messages

  function WindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT; virtual;
  end; // TMyWindow = object(TWindow)

var
  oApp        : TApplication;
  poMyMainWin : PMyWindow;
  glf         : boolean; // necessary to use a special assignment operator

constructor TMyWindow.Init(strWinTitlePrm:ShortString);
//=====================================================
begin
inherited Init(strWinTitlePrm);

// This line is all what is needed to have a status line.
new(poStatusLine, Init(@Self));
end;  // TMyWindow.Init

destructor TMyWindow.Done;
//=========================
begin

inherited Done;
end;  // TMyWindow.Done

procedure TMyWindow.Test1;
//========================
// Test the assignment operator  :=
// Unfortunatly, the assignment operator cannot be defined as I would like.
// See comments in tEx059Unit.pp
// Thus I use the boolean operator  <=  as an assignment operator,
// ignoring the result. See comments in  tEx061Unit.pp
var
  rR1,rR2,rR3 : RRecTest;
begin
rR1.nAA:=11111;  rR1.nBB:=22211;  rR1.nCC:=33311;
rR2.nAA:=11122;  rR2.nBB:=22222;  rR2.nCC:=33322;
rR3.nAA:=11133;  rR3.nBB:=22233;  rR3.nCC:=33333;

glf:=rR1<=rR2;
DBW(1, 'rR1=' + ITS(rR1.nAA) + ITS(rR1.nBB) + ITS(rR1.nCC));
DBW(1, 'rR2=' + ITS(rR2.nAA) + ITS(rR2.nBB) + ITS(rR2.nCC));

// glf is ignored and not interesting.
// The  <=  operator is used as an assignment, and it works well.
glf:=rR1<=rR2 + rR3;
DBW(1, 'rR1=' + ITS(rR1.nAA) + ITS(rR1.nBB) + ITS(rR1.nCC));

DBW(1, '');
DBW(1, 'The := operator doesn''t give the wanted result. The filed nCCC is also copied');
rR1:=rR2 + rR3;
DBW(1, 'rR1=' + ITS(rR1.nAA) + ITS(rR1.nBB) + ITS(rR1.nCC));
end;  // TMyWindow.Test1

procedure TMyWindow.Test2;
//========================
// Test really the unit  xVectRN.pp
var
  vec11,vec12,vec13, // From familly one, can have index till   10
  vec21,vec22,vec23  // From familly two, can have index till 1000
                     // this is defined at calling the constructor Init.
                     : RVectRNFloat;
  nn          : integer;
  vScalProd,
  vSign       : Float;
begin
// To have the possibility to define some vectors.
// Two groupes of vectors, one having a largeer memory allocation
VNCreateNewVecRNFamilly(1,   10); // 1 = Familly
VNCreateNewVecRNFamilly(2, 1000); // 2 = Familly

// Initialise the vectors
VNInit(vec11, 1);  VNInit(vec12, 1);  VNInit(vec13, 1); // 1 = familly
VNInit(vec21, 2);  VNInit(vec22, 2);  VNInit(vec23, 2); // 2 = familly

// Set values to these vectors, and define their dimension.
// Maximum   10 for vec11..vec13
// Maximum 1000 for vec21..vec23
VNSetToBasis(vec11, 5,1); // Dimention = 5,  vector=(1,0,0,0,0)
VNSetToBasis(vec12, 5,2); // Dimention = 5,  vector=(0,1,0,0,0)

// !!!!! DANGER, do NOT do this
//vec13:=vec11 + vec12;
//....****...

// But this instead
glf:=vec13<=vec11 + vec12; // This sets also the dimension of pvec13

DBW(1, 'Dim(vec13)=' + ITS5(vec13.nIndMax));
DBW(1, 'vec13=(1,1,0,0,0)' + VNVectToStr(vec13, 1,5));

// Define values directly for other vectors
vSign:=1.0;
for nn:=1 to 500 do begin
   vec21.pavV^[nn]:=1.0/nn;
   vec22.pavV^[nn]:=vSign/nn;
   vSign:=-vSign;
   end;
vec21.nIndMax:=500; // set the dimension
vec22.nIndMax:=499; // set the dimension

DBW(1, 'norme2(vec21)=' + FTS(Norme2(vec21)) + ' =~1.64493 = Pi^2/6');

// !!!!! DANGER, do NOT do this
//vec23:=vec21 + vec22;
// ...****...

// But This
glf:=vec23<=vec21 + vec22; // Sets the dimension to 500

DBW(1, 'Dim(vec23=' + ITS5(vec23.nIndMax));
DBW(1, 'vec23[..500]' + VNVectToStr(vec23, 496,500));
DBW(1, '-----------------------------------');

// Assigning vectors with values, and a difficult test...
VNAssign(vec11, 1,10, 1,2,3,4,5); // component from 6 to 10 are set to 0
VNAssign(vec12, 1,10, 5,4,3,2,1);
VNAssign(vec13, 1,10, 4,5,2,3,0);

// The difficulty is that two temporary results are necessary to compute this
// scalar product. After some test, it works well.
vScalProd:=(vec11 + vec12) * (vec12 - vec13); // =(6,6,6,6,6) * (1,-1,1,-1,1) = 6
vScalProd:=(vec11 + vec12) * (vec12 - vec13); // =(6,6,6,6,6) * (1,-1,1,-1,1) = 6
vScalProd:=(vec11 + vec12) * (vec12 - vec13); // =(6,6,6,6,6) * (1,-1,1,-1,1) = 6
DBW(1, 'ScalProd = 6 =' + FTS(vScalProd));

glf:=vec13<=vec11 + vec12; // This sets also the dimension of pvec13
DBW(1, 'Dim(vec13)=' + ITS5(vec13.nIndMax));
DBW(1, 'vec13=(6,6,6,6,6)=' + VNVectToStr(vec13, 1,5));
DBW(1, '      (6,6,6,6,6)=' + VNVectToStr(vec11 + vec12, 1,5));
// For this last line, a temporary vector has been created.
// But it is set free at the end of the  VNVectToStr  procedure
// Trying again several times does not increase the number of temporary vectors.

DBW(1, '-----------------------------------------');

// Here, even with the parenthesis, the compilator decide to do
// the first addition, then the substraction, then the last addition
// and only after it, to do the scalar product,
// and finally doing the multiplication  scalar by a vector.
// Thus three temporary vectors are needed.
// If the compilator had choosen to do the scalar product before
// the last vector addition, then only two temporary vectors would have been needed
DBW(1, '...=' +
   VNVectToStr(((vec11 + vec12)*(vec12 - vec13)) * (vec11 + vec13), 1,5));
DBW(1, '      (6,6,6,6,6)=' + VNVectToStr(vec11 + vec12, 1,5));
DBW(1, '      (6,6,6,6,6)=' + VNVectToStr(vec11 + vec12, 1,5));

// Here also, three temporary vectors are needed. But it all works well
DBW(1, 'Norme=' +
   FTS(Norme((vec11 + vec12)*(vec12 - vec13) * (vec11 + vec13))));

// Here also, three temporary vectors are needed. But it all works well
DBW(1, '...=' +
   VNVectToStr((vec11 + vec12)*(vec12 - vec13) * (vec11 + vec13), 1,5));

// Free the allocated memory
VNDone(vec21);  VNDone(vec22);  VNDone(vec23);
VNDone(vec11);  VNDone(vec12);  VNDone(vec13);

VNDisposeVecRNFamilly(2); // 2 = Familly
VNDisposeVecRNFamilly(1); // 1 = Familly
end;  // TMyWindow.Test2

procedure TMyWindow.Test3;
//========================
begin
end;  // TMyWindow.Test3

procedure TMyWindow.Test4;
//========================
begin
end;  // TMyWindow.Test4

function TMyWindow.WMCommand(wPar:WPARAM; lPar:LPARAM):LRESULT;
//=============================================================
// Handles the menu messages
Var wNrMenu     : word;
begin
WMCommand := 0; // Default return value when processing a message

if (lPar <> 0) then begin
   // call the parent WMCommand method.
   WMCommand:=inherited WMCommand(wPar, lPar);
   exit;
   end;

// for the menus,  lPar = 0
//=========================
wNrMenu   := LoWord(wPar);
Case wNrMenu Of
   101 : Test1;
   102 : Test2;
   103 : Test3;
   104 : Test4;

   else WMCommand:=inherited WMCommand(wPar, lPar);
   end;  // Case NrMenu Of
end;  // TMyWindow.WMCommand

function TMyWindow.WindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT;
//======================================================================================
begin
// Default treatment of a message. Does nearly nothing
WindowProc := inherited WindowProc(hWindow, wMsg, wPar, lPar);
end;  // TMyWindow.WindowProc

Begin // MAIN ******
// Name under which the main window is registered. Spaces are not allowed
oApp.Init('Example059');

// Creation of the main window
new(poMyMainWin, Init('tEx059. Testing xVectRN.pp.'));

oApp.Run;
oApp.Done;  // The main window object is disposed here.

glf:=glf; // To avoid a Hint
End.

