unit matheunit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Gmp, Math;

type
  tExtPoint = record
    x,y: extended;
  end;
  tExtPointArray = array of tExtPoint;
  pTExtPointArray = ^tExtPointArray;
  tLongintArray = array of longint;
  pTLongintArray = ^tLongintArray;
  tExtendedArray = array of extended;

function plus(a,b: tExtPoint): tExtPoint;
function durch(a: tExtPoint; b: extended): tExtPoint;
function myFrac(x: extended): extended;
function mpfToStr(f: mpf_t): string;
function signSqr(x: extended): extended; inline;
function mpfMyRoot(rad: mpf_t; wzlExp: int64): extended;
function myTimeToStr(t: extended): string;
function cmpStr(s1,s2: string): longint;
function mitte(s1,s2: string): string;
function myFloatToStr(x: extended): string;
function myStrToFloat(s: string): extended;

implementation

function plus(a,b: tExtPoint): tExtPoint;
begin
  result.x:=a.x+b.x;
  result.y:=a.y+b.y;
end;

function durch(a: tExtPoint; b: extended): tExtPoint;
begin
  result.x:=a.x/b;
  result.y:=a.y/b;
end;

function myFrac(x: extended): extended;
begin
  result:=frac(x);
  while result<0 do
    result:=result+1;
end;

function mpfToStr(f: mpf_t): string;
var
  ex:  int64;
  off: byte;
begin
 result:=mpf_get_str(nil,ex,10,0,f);
 off:=1+byte(pos('-',result)=1);
 if result='' then
   result:='0'
 else if ex=1 then
   result:=copy(result,1,off)+','+copy(result,off+1,length(result)-off)
 else
   result:=copy(result,1,off)+','+copy(result,off+1,length(result)-off)+' * 10^'+inttostr(ex-1);
end;

function signSqr(x: extended): extended;
begin
 result:=sign(x)*sqr(x);
end;

function mpfMyRoot(rad: mpf_t; wzlExp: int64): extended;
var
  ex: int64;
begin
  result:=power(mpf_get_d_2exp(ex,rad),1/wzlExp);
  result:=result*power(2,ex/wzlExp);
end;

function myTimeToStr(t: extended): string;
var
  tim: int64;
begin
 tim:=floor(t*24*60*60);
 result:=inttostr(tim mod 10)+'s';
 tim:=tim div 10;
 if tim=0 then exit;
 result:=inttostr(tim mod 6)+result;
 tim:=tim div 6;
 if tim=0 then exit;
 result:=inttostr(tim mod 10)+'min '+result;
 tim:=tim div 10;
 if tim=0 then exit;
 result:=inttostr(tim mod 6)+result;
 tim:=tim div 6;
 if tim=0 then exit;
 result:=inttostr(tim mod 24)+'h '+result;
 tim:=tim div 24;
 if tim=0 then exit;
 result:=' '+result;
 if (tim mod 7)<>1 then
   result:='e'+result;
 result:=inttostr(tim mod 7)+'Tag'+result;
 tim:=tim div 7;
 if tim=0 then exit;
 result:=' '+result;
 if tim<>1 then
   result:='n'+result;
 result:=inttostr(tim)+'Woche'+result;
end;

function cmpStr(s1,s2: string): longint;
var
  i: longint;
begin
 for i:=1 to min(length(s1),length(s2)) do
   if s1[i]<>s2[i] then begin
     result:=2*byte(s1[i]>s2[i])-1;
     exit;
   end;
 if length(s1)<>length(s2) then begin
   result:=2*byte(length(s1)>length(s2))-1;
   exit;
 end;
 result:=0;
end;

function mitte(s1,s2: string): string;
var
  i:    longint;
  w,nw: word;
begin
 setlength(result,max(length(s1),length(s2)));
 w:=0;
 for i:=length(result) downto 1 do begin // result:= "s1+s2";
   if i<=length(s1) then
     w:=w+byte(s1[i]);
   if i<=length(s2) then
     w:=w+byte(s2[i]);
   result[i]:=char(w and $ff);
   w:=w shr 8;
 end;
 result:=char(w)+result;
 w:=0;
 for i:=1 to length(result) do begin
   nw:=byte(odd(byte(result[i])+w));
   result[i]:=char((byte(result[i])+w) div 2);
   w:=nw shl 8;
 end;
 if w<>0 then
   result:=result+char(w div 2);
 if result[1]<>#0 then begin
   writeln('Fehler bei der Mittenfindeung!');
   halt;
 end;
 delete(result,1,1);
end;

function myFloatToStr(x: extended): string;
var
  i,e: longint;
begin
 e:=0;
 if x<0 then begin
   result:='-';
   x:=-x;
 end
 else
   result:='';
 if x=0 then begin
   result:='0';
   exit;
 end;
 while x<1 do begin
   dec(e);
   x:=x*10;
 end;
 while x>=10 do begin
   inc(e);
   x:=x/10;
 end;
 result:=result+char(ord('0')+floor(x))+'.';
 for i:=0 to 20 do begin
   x:=(x-floor(x))*10;
   result:=result+char(ord('0')+floor(x));
 end;
 if e<>0 then
   result:=result+'E'+inttostr(e);
end;

function myStrToFloat(s: string): extended;
var
  i,e: longint;
  neg: boolean;
begin
 if pos('E',s)>0 then begin
   e:=strtoint(rightStr(s,length(s)-pos('E',s)));
   delete(s,pos('E',s),length(s));
 end
 else e:=0;
 if pos('.',s)=0 then begin
   result:=strtoint(s)*power(10,e);
   exit;
 end;
 neg:=leftStr(s,1)='-';
 if neg then
   delete(s,1,1);
 if pos('.',s)=2 then begin
   result:=0;
   for i:=length(s) downto 3 do
     result:=result/10 + ord(s[i])-ord('0');
   result:=result/10 + ord(s[1])-ord('0');
 end
 else result:=strtofloat(s);
 result:=result*power(10,e);
 if neg then
   result:=-result;
end;

end.