unit wUtiles0;

{ Feel free to use this unit as you want.
  First developped by Bernard Gisin

  Some utilities
  ----------------------------------------------------------------}

INTERFACE
//"""""""

uses  wGlobals2, Windows;

// Splits a complete filename, with its path, to the
// directory part, name part and extension part.
// It does the same as the FSplit from DOS, uses it,
// but this avoid using the DOS unit in other units.
procedure FileSplit(strPath:ShortString; var strDir,strName,strExt:ShortString);
//==============================================================================

function GetFloatValue(nBeg:integer; strS:ShortString; var nEnd:integer):Float;
//=============================================================================
{ From the string strS containing Float values, return the first floating
  point number, begining at the position nBeg.
  Ignore all non numerical characters preceding and following the number.
  nEnd = 1 + position of the last character determining the number.
       Example strS = 'ab345suite -45.67 was the last',
  GetFloatValue(   1, strS, nEnd) returns 345.0  and nEnd = 6
  GetFloatValue(nEnd, strS, nEnd) returns -45.67 and nEnd = 18
  GetFloatValue(nEnd, strS, nEnd) returns   0.0  and nEnd = 0
  nEnd = 0 if no number found.

  It is usefull to get all numbers coded in a string
-------------------------------------------------------------------}

function GetIntValue(nBeg:integer; strS:ShortString; var nEnd:integer):int32;
//===========================================================================
// Same as GetFloatValue, but returns an int32

function GetWordValue(nBeg:integer; strS:ShortString; var nEnd:integer):word32;
//=============================================================================
// Same as GetFloatValue, but returns a word32

function GetCharPos(wPos:word32; ch:Char; const strS:ShortString):word;
//=====================================================================
// Return the position of the first occurence of the  ch  character
// in the string strS, starting at position wPos. (Thus the result will be >= wPos)
// If the  ch  character is not found, return 0.

function GetSkipSpacesPos(wPos:word32; const strS:ShortString):word;
//==================================================================
// Return the position of the first non space character in the string,
// starting at position wPos. (Thus the result will be >= wPos)
// Return length(strS)+1, if there are only spaces in strS[nPos..length(strS)]

procedure InterpretTabs(var strS:ShortString);
//============================================
// Return the same string, with the two chars  "\t"  in the string
// converted to one control char which has ASCII code 8
// and represent the tabulation

function AccelTableMSGCreate(wMsgNum:Word32):HACCEL;
// =================================================
// Reads the description in the .msg file at number wMsgNum,
// and creates an accelerator table from it.

procedure FromRGB(wColor:word32; var bRed,bGreen,bBlue:byte);
//===========================================================
// From a RGB color defined in  wColor,  extract the red green blue colors

function Tan(vX:Float):Float;
{===========================}

function ArcSin(vX:Float):Float;
{==============================}

function ArcCos(vX:Float):Float;
{==============================}

function AngleR2(vX,vY:Float):Float;
{==================================}
// Return the angle in radians in [-Pi, Pi] between the (vX,vY) vector and
// the X axis.


IMPLEMENTATION
//""""""""""""

Uses wMessages2, wDebug0, DOS;

var nNotUsed : integer; // only to avoid an error message while compliling in DevPascal 1.9

procedure FileSplit(strPath:ShortString; var strDir,strName,strExt:ShortString);
//==============================================================================
begin
FSplit(strPath, strDir, strName, strExt);
end;  // FileSplit

function GetFloatValue(nBeg:integer; strS:ShortString; var nEnd:integer):Float;
//=============================================================================
{ From the string strS containing Float values, return the first floating
  point number, begining at the position nBeg.
  Ignore all non numerical characters preceding and following the number.
  nEnd = 1 + position of the last character determining the number.
       Example strS = 'ab345suite -45.67 was the last',
  GetFloatValue(   1, strS, nEnd) returns 345.0  and nEnd = 6
  GetFloatValue(nEnd, strS, nEnd) returns -45.67 and nEnd = 18
  GetFloatValue(nEnd, strS, nEnd) returns   0.0  and nEnd = 0
  nEnd = 0 if no number found.

  It is usefull to get all numbers coded in a string
-------------------------------------------------------------------}
var
  nLen,
  nCode            : integer;
  vVal             : Float;

begin //  GetFloatValue
nEnd:=0;
GetFloatValue:=0;  // Default values if no numbers found

if (nBeg < 1) then exit; // no number found

nLen:=length(strS);

// Skip all characters which cannot be in a number
while (nBeg <= nLen) and
       not (strS[nBeg] in ['0'..'9', '-', '+', '.']) do inc(nBeg);
if (nBeg > nLen) then exit; // no numbers found

// keeps the string from the first numerical character.
strS:=copy(strS, nBeg, 255);
val(strS, vVal, nCode);

if (nCode = 0) then begin
   // success, a number was found
   nEnd:=nLen+1; // it was the last number of the string
   GetFloatValue:=vVal;
   exit;
   end;

// characters are following, they must be removed for the conversion
strS:=copy(strS, 1, nCode-1);
val(strS, vVal, nCode);

if (nCode = 0) then begin
   nEnd:=nBeg + length(strS);  // position of the first char following the number
   GetFloatValue:=vVal;
   exit;
   end;

// else there was no number after the  nBeg  character.
end;  // GetFloatValue

function GetIntValue(nBeg:integer; strS:ShortString; var nEnd:integer):int32;
//===========================================================================
// Same as GetFloatValue, but returns an int32
var vVal : Float;
begin
vVal:=GetFloatValue(nBeg, strS, nEnd);

// Overflow testing
if (vVal >  2147483647.0) then vVal:= 2147483647.0;
if (vVal < -2147483648.0) then vVal:=-2147483648.0;

GetIntValue:=Round(vVal);
end;  // GetIntValue

function GetWordValue(nBeg:integer; strS:ShortString; var nEnd:integer):word32;
//=============================================================================
// Same as GetFloatValue, but returns a word32
var vVal : Float;
begin
vVal:=GetFloatValue(nBeg, strS, nEnd);

// Overflow testing
if (vVal >  4294967295.0) then vVal:= 4294967295.0;
if (vVal <           0.0) then vVal:=          0.0;

// Round generate an error 207 if vVal > 2147483647 = 2^31-1
if (vVal >  2147483647.0) then vVal:= 4294967296.0 - vVal;

GetWordValue:=Word32(Round(vVal));
end;  // GetWordValue

function GetCharPos(wPos:word32; ch:Char; const strS:ShortString):word;
//=====================================================================
// Return the position of the first occurence of the  ch  character
// in the string strS, starting at position wPos. (Thus the result will be >= wPos)
// If the  ch  character is not found, return 0.
begin
while (wPos <= length(strS)) do begin
   if (strS[wPos] = ch) then begin
      GetCharPos:=wPos;  // character found.
      exit;
      end;

   inc(wPos);
   end;

GetCharPos:=0; // character not found.
end;  // GetCharPos

function GetSkipSpacesPos(wPos:word32; const strS:ShortString):word;
//==================================================================
// Return the position of the first non space character in the string,
// starting at position wPos. (Thus the result will be >= wPos)
// Return length(strS)+1, if there are only spaces in strS[nPos..length(strS)]
begin
while (wPos <= length(strS)) and (strS[wPos] = ' ') do inc(wPos);

GetSkipSpacesPos:=wPos;
end;  // GetSkipSpacesPos

procedure InterpretTabs(var strS:ShortString);
//============================================
// Return the same string, with the two chars  "\t"  in the string
// converted to one control char which has ASCII code 8
// and represent the tabulation
var
  wPos,
  ww          : word;
begin
wPos:=1;

// loop to search for all "\t"
repeat
   // look for a "\"
   while (wPos < length(strS)) and (strS[wPos] <> '\') do inc(wPos);

   if (strS[wPos] <> '\') then exit; // nothing to do

   if (UpCase(strS[wPos+1]) = 'T') then begin
      // Convert the '\t' into the character #8 (a control character)
      strS[wPos]:=#8;
      wPos:=wPos+1; // strS[wPos] = 't' here

      // shift to the left the rest of the string.
      for ww:=wPos+1 to length(strS) do strS[ww-1]:=strS[ww];

      // the string length is shorter.
      strS[0]:=char(length(strS)-1);
      end;
   until FALSE; // quit the loop with an exit;
end;  // InterpretTabs

function AccelTableMSGCreate(wMsgNum:Word32):HACCEL;
// =================================================
// Reads the description in the .msg file at number wMsgNum,
// and creates an accelerator table from it.
var
  hAccelL     : HACCEL;
  arAccel     : array[1..1000] of ACCEL;
  // Supose that we will not have more than 1000 accelerators.
  strL        : ShortString;
  wPos,       // position in the strL string
  wNbAccel,   // number of accelerator defined
  wKey,       // = key corresponding to the accelerator
  wSecurity   : word;
  bFlags      : Byte;    // = fVirt flags
  fIsVirt     : boolean; // = TRUE if the FVIRTKEY flag is to be set.
  wCmd        : word32;  // = number generated by the accelerator

   procedure InterpretMSGAccel;
   //==========================
   begin
   while (strL[wPos] = ' ') do inc(wPos); // Skip Spaces

   // Put a combinaison of the following flags, separated with the "or" operator
   // FALT or FCONTROL or FNOINVERT or FSHIFT or FVIRTKEY
   // FNOINVERT is not treated. not usefull I think
   bFlags:=0;
   fIsVirt:=TRUE; // if not other wise specified, use the virtual key code.

   // Look for the Flags
   while (strL[wPos] = '^') or (strL[wPos] = '&') or
         (strL[wPos] = '%') or (strL[wPos] = '~') do begin
      if (strL[wPos] = '^') then bFlags:=bFlags or FCONTROL;
      if (strL[wPos] = '&') then bFlags:=bFlags or FALT;
      if (strL[wPos] = '%') then bFlags:=bFlags or FSHIFT;
      if (strL[wPos] = '~') then fIsVirt:=FALSE;
      inc(wPos);
      end; // while

   // get the key corresponding to the accelerator
   wKey:=ord(strL[wPos]);
   inc(wPos);

   // Treat the special case of the F1 to F24 keys.
   if (wKey = ord('F')) and (strL[wPos] >= '0') and (strL[wPos] <= '9') then begin
      // we have a virtual key code, in  [VK_F1..VK_F24]
      fIsVirt:=TRUE;
      wKey:=ord(strL[wPos]) - ord('0'); // get the number following the "F"
      inc(wPos);
      if (strL[wPos] >= '0') and (strL[wPos] <= '9') then begin
         wKey:=wKey * 10 + ord(strL[wPos]) - ord('0'); // get the second number
         inc(wPos);
         if (wKey =0) or (wKey > 24) then exit;  // invalide key number
         end;

      wKey:=VK_F1 -1 + wKey;
      end // if (wKey = ord('F')) and (strL[wPos] >= '0') and (strL[wPos] <= '9')
   else if (wKey = ord('N')) and
      (((strL[wPos] >= '0') and (strL[wPos] <= '9')) or
       (strL[wPos] = '+') or (strL[wPos] = '-') or
       (strL[wPos] = '*') or (strL[wPos] = '/') or
       (strL[wPos] = '.')) then begin
      // case of the keys of the numeric pad
      // we have a virtual key code, in  [VK_F1..VK_F24]
      fIsVirt:=TRUE;
      if      (strL[wPos] = '+') then wKey:=VK_ADD
      else if (strL[wPos] = '-') then wKey:=VK_SUBTRACT
      else if (strL[wPos] = '*') then wKey:=VK_MULTIPLY
      else if (strL[wPos] = '/') then wKey:=VK_DIVIDE
      else if (strL[wPos] = '.') then wKey:=VK_DECIMAL
      else // a number follows
         wKey:=VK_NUMPAD0 + ord(strL[wPos]) - ord('0'); // get the number following the "N"

      inc(wPos);
      end // if (wKey = ord('N')) and ...
   else if (wKey = ord('V')) and (strL[wPos] >= '0') and (strL[wPos] <= '9') then begin
      // we have a virtual key code, the code is given by the number which follows
      fIsVirt:=TRUE;
      wKey:=ord(strL[wPos]) - ord('0'); // get the number following the "V"
      inc(wPos);
      if (strL[wPos] >= '0') and (strL[wPos] <= '9') then begin
         wKey:=wKey * 10 + ord(strL[wPos]) - ord('0'); // get the second number
         inc(wPos);
         end;
      if (strL[wPos] >= '0') and (strL[wPos] <= '9') then begin
         wKey:=wKey * 10 + ord(strL[wPos]) - ord('0'); // get the third number
         inc(wPos);
         end;

      // no invalid number testing.
      end // if (wKey = ord('V')) and (strL[wPos] >= '0') and (strL[wPos] <= '9')
   else begin
      // We must treat the case of virtual keys.
      if fIsVirt then begin
         if      (wKey >= ord('0')) and (wKey <= ord('9')) then wKey:=wKey + VK_0 - ord('0')
         else if (wKey >= ord('A')) and (wKey <= ord('Z')) then wKey:=wKey + VK_A - ord('A')
         else if (wKey >= ord('a')) and (wKey <= ord('z')) then wKey:=wKey + VK_A - ord('a')
         else fIsVirt:=FALSE; // not a virtual key code
         end;
      // else wKey is already correct.
      end; // else of  // if (wKey = ord('F')) and (strL[wPos] >= '0') and (strL[wPos] <= '9')

   if fIsVirt then bFlags:=bFlags or FVIRTKEY;

   while (strL[wPos] = ' ') do inc(wPos); // Skip Spaces
   inc(wPos); // Skip the '='

   if (wPos > length(strL)) then exit;  // nothing more defined here. => not an accelerator
   while (strL[wPos] = ' ') do inc(wPos); // Skip Spaces

   if (strL[wPos] < '0') or (strL[wPos] > '9') then exit; // no number follows

   // get the number generated by the accelarator
   wCmd:=GetIntValue(wPos, strL, wPos);

   if (wCmd = 0) or (wCmd > 65535) then exit; // not a valid number
//DBW(1, 'Accel=' + ITS5(bFlags) + ITS5(wKey) + ITS5(wCmd));

   // Here we got a valide accelerator description
   // Add the accelerator to the table.
   if (wNbAccel < 1000) then inc(wNbAccel);
   arAccel[wNbAccel].fVirt :=bFlags;
   arAccel[wNbAccel].key   :=wKey;
   arAccel[wNbAccel].Cmd   :=LoWord(wCmd);
   end;  // InterpretMSGAccel;

begin // AccelTableMSGCreate
//""""""""""""""""""""""""""
AccelTableMSGCreate:=0; // in case of errors

if (not ExistMsgNumber(wMsgNum)) then exit; // noting defined.

wNbAccel:=0;
strL:=GetMsg(msgNext);
wSecurity:=100; // 100 lines maximum.
repeat
   strL[length(strL)+1]:=#0; // put a sentinel at the end of the string.
   wPos:=1;

   // Get all accelerators defined in one line
   repeat
      // get one accelerator key
      InterpretMSGAccel;

      // look the end of one definition, given by a ';'
      while (wPos < length(strL)) and (strL[wPos] <> ';') do inc(wPos);
      inc(wPos); // skip the ';'
      until (wPos >= length(strL));

   // get more accelerators
   strL:=GetMsg(msgNext);
   dec(wSecurity);
   until (strL = '...END') or (wSecurity <= 0);

// Create an accelerator table
if (wNbAccel > 0) then hAccelL:=CreateAcceleratorTable(arAccel[1], wNbAccel);
AccelTableMSGCreate:=hAccelL;
end;  // AccelTableMSGCreate

procedure FromRGB(wColor:word32; var bRed,bGreen,bBlue:byte);
//===========================================================
// From a RGB color defined in  wColor,  extract the red green blue colors
var
  colL : TypeColor;
begin
colL.wColor:=wColor;
bRed   :=colL.bRed;
bGreen :=colL.bGreen;
bBlue  :=colL.bBlue;
end;  // FromRGB

function Tan(vX:Float):Float;
{===========================}
var vS,vC : Float;
begin
vC:=Cos(vX);
if (vC = 0) then begin
   vS:=Sin(vX);
   if (vS > 0) then Tan:= 1e30
   else             Tan:=-1e30;
   exit;
   end;

Tan:=vC / Sin(vX);
end; { - Tan - }

function ArcSin(vX:Float):Float;
{==============================}
begin
if (vX >=  1) then begin ArcSin:= Pi/2; exit; end;
if (vX <= -1) then begin ArcSin:=-Pi/2; exit; end;
ArcSin:= ArcTan (vX / sqrt (1-sqr (vX)));
end;  { - ArcSin - }

function ArcCos(vX:Float):Float;
{==============================}
begin
if (vX > 0) then begin
   if (vX >=  1) then begin ArcCos:=  0;   exit; end;
   ArcCos:= ArcTan (sqrt (1-sqr (vX)) / vX);
   end
else begin
   if (vX <= -1) then begin ArcCos:= Pi;   exit; end;
   if (vX  =  0) then begin ArcCos:= Pi/2; exit; end;
   ArcCos:= Pi + ArcTan (sqrt (1-sqr (vX)) / vX);
   end;
end;  { - ArcCos - }

function AngleR2(vX,vY:Float):Float;
{================================}
var theta : Float;
begin { - AngleR2 - }
if (vX = 0.0) then begin
   if (vY >= 0.0) then theta:= Pi/2.0
   else                theta:=-Pi/2.0;
   end
else theta:=ArcTan(vY / vX);

if (vX < 0.0) then
   if (vY < 0.0) then theta:=theta - Pi
   else               theta:=theta + Pi;

AngleR2:=theta;
end;  { - AngleR2 - }


End.  // unit wUtiles0;

