{---------------------------------------------------------------------------}
{ Unit Flib   Funzioni/procedure di supporto per la programmazione
{             in Delphi 2.0 per Win95/98  -  By Claudio Fin (C) 2000
{---------------------------------------------------------------------------}

unit flib;

interface

uses SysUtils, Classes, Windows;


type

{---------------------------------------------------------------------------}
{  Classe TListaStringhe  - Lista di stringhe dinamica ad alta capacita'
{---------------------------------------------------------------------------}

  PElementoListaStringhe=^TElementoListaStringhe;
  TElementoListaStringhe=record
      s:string;
      prec:PElementoListaStringhe;
      succ:PElementoListaStringhe;
  end;


  TListaStringhe=object
    primo,ultimo :  PElementoListaStringhe;
    count        :  integer;
    procedure Init;
    procedure Add(const s:string);
    function  Str(n:integer):string;
    procedure Imp(n:integer; const s:string);
    procedure Insert(n:integer; const s:string);
    procedure Delete(n:integer);
    procedure Done;
    procedure Clear;
    procedure LoadFromFile(const s:string);
    procedure SaveToFile(const s:string);
  end;

{
  UTILIZZO TLISTASTRINGHE:
  Si crea un istanza:       var X:TListaStringhe;

  Si aggiunge una stringa:  X.Add('stringa');

  Si imposta il valore
  della stringa N:          X.Imp(n,'stringa');

  Si legge il valore
  della stringa N:          X.Str(n):string

  Si inserisce una
  stringa alla posiz.N:     X.Insert(n,'stringa');

  Si cancella la stringa
  alla posizione N:         X.Delete(n);

  Si cancellano tutte
  le stringhe:              X.Clear;

  Si legge quante stringhe
  sono presenti:            X.Count:integer

  Salvare su file:          X.SaveToFile('nomefile');

  Leggere da file:          X.LoadFromFile('nomefile');

  Si termina l'utilizzo:    X.Done;

  Le stringhe hanno indirizzo da 1 a "count", se non ci sono
  stringhe "count" vale 0. Se si imposta il valore di una
  stringa oltre "count" vengono automaticamente create stringhe
  nulle fino al valore di N specificato, lo stesso discorso vale se
  si tenta di inserire una stringa oltre il numero di stringhe
  presenti. In ogni caso non si verificano condizioni di errore,
  la lettura da un indice non valido ritorna stringa nulla. Il valore
  di COUNT non va assolutamente modificato manualmente in quanto è
  usato internamente da TListaStringhe per il suo funzionamento!

  SCOPO
  Avere a disposizione una lista di stringhe che puo' crescere
  indefinitamente in modo dinamico, che non produca errori bloccanti
  in caso di utilizzo non corretto, e che permetta l'inserimento,
  cancellazione, modifica di ogni elemento e la lettura/scrittura
  da/su file di testo.
}



{---------------------------------------------------------------------------}
{  Classe TTextReader  -  Lettore di file di testo ad uso semplificato
{---------------------------------------------------------------------------}

  TTextReader = object
    f1   :  text;
    eod  :  boolean;
    procedure Init(const nf:string);
    procedure Rd(var s:string);
    procedure Done;
  end;

{
  UTILIZZO TEXTREADER:
  Si crea un istanza:       var X:TTextReader;
  Si apre il file:          X.Init('nomefile');
  Si leggono i dati:        X.Rd(variabile stringa);
  Si controlla se possono
  essere letti dei dati:    X.Eod   (true=dati terminati)
  Si termina l'utilizzo:    X.Done;


  USO TIPICO:       var X:TTextReader; s:string;

                    X.Init('nomefile.txt');
                    while not X.Eod do X.Rd(variabile);
                    X.Done;

  SCOPO
  Effettuare un accesso semplificato a file testuali, ogni condizione
  di errore (file non trovato, lettura oltre la fine del file ecc...)
  imposta Eod a True e riporta stringa nulla.
}


{---------------------------------------------------------------------------}
{ Classe TDataReader  -  Lettore di dati delimitati da file di testo
{---------------------------------------------------------------------------}

  TDataReader = object
    TextReader : TTextReader;
    StringList : TListaStringhe;
    punt,ele   : integer;
    eod        : boolean;
    procedure Init(const nf:string);
    procedure RdStr(var s:string);
    procedure RdInt(var v:integer);
    procedure RdReal(var v:extended);
    procedure Restore(const s:string);
    procedure Done;
    procedure ScomponiRiga(var s:string);
  end;

{
  SINTASSI DEI DATI TESTUALI LEGGIBILI CON DATAREADER :
  Righe vuote vengono ignorate, con // si possono inserire dei
  commenti, tutto quello che c'è dopo // viene ignorato.
  gli elementi vanno separati con il simbolo pipe (|), il pipe
  non deve essere messo prima del primo elemento o dopo l'ultimo
  della riga. Le label devono cominciare con il punto e virgola (:)
  e sono case insensitive. I valori interi possono essere scritti in
  decimale, esadecimale (seguiti da H o h) o binario (seguiti da B o b).
  I valori interi negativi possono essere scritti solo in decimale.
  Esempio:

  :blocco1 | -125 | 855 | -13.048 | pippo | 0F5AH    | 1001B
       482 | stringa con piu' parole...   | :blocco2 | 0.0015

  In questo esempio il blocco 1 contiene 8 elementi, il blocco2
  uno solo. I dati sono memorizzati come stringhe e vengono convertiti
  nel tipo richiesto al momento della lettura con RdInt, Rdreal ecc...
  Tra gli elementi e i pipe possono oppure no esserci degli spazi,
  che vengono comunque ignorati. Due pipe che non contengono nulla
  ritornano una stringa nulla che viene memorizzata comunque.

  UTILIZZO DATAREADER:
  Si crea un istanza:   var X:TDataReader;
  Si caricano i dati:       X.Init('nomefile');
  Si controlla se ci
  sono elementi:            X.Eod;
  Si leggono i dati
  sequenzialmente uno
  alla volta:               X.RdInt(variabile integer);
                            X.RdReal(variabile real);
                            X.RdStr(variabile stringa);
  Si reimposta la lettura
  da un punto specifico:    X.Restore('label');
  Si termina l'utilizzo:    X.Done;

  In caso di errorecome di file errato, dati non validi, lettura di
  un numero di dati maggiore di quello presente si ottengono stringhe
  nulle o valori a zero. Se la label non viene trovata il puntatore dei
  dati va a fine lista e si ottengono stringhe nulle. Per portare il
  puntatore all'inizio passare stringa nulla in Restore.

  SCOPO
  Aquisire dati da un file testuale con il quale si possono parametrizzare
  delle funzioni o dei messaggi senza intervenire sul programma e senza
  ricorrere ogni volta a un formato dati diverso. Il controllo della
  correttezza e della sequenza dei dati inseriti è a cura del programmatore.
}


{---------------------------------------------------------------------------}
{ Classe TPortaSeriale  -  Accesso semplificato alla seriale (BASIC like)
{---------------------------------------------------------------------------}

  TComPorte=(com1,com2);
  TComParita=(n,o,e,m,s);


  TPortaSeriale=object
    ComIsOpen  : boolean;
    ComHandle  : Thandle;
    ComDCB     : TDCB;
    ComTimeout : TCommTimeouts;
    procedure Tx(const s:string);
    function  Rx:string;
    procedure Close;
    procedure Open(port:TComPorte; vel:integer;
              par:TComparita; bit,sbit:integer);
  end;

{
  UTILIZZO PORTA SERIALE:
  Si crea un istanza:     var X:TPortaSeriale;

  Si apre la porta:           X.Open(porta,veloc,parità,bit,stopbit);

  Si trasmette una stringa:   X.Tx('stringa');

  Si riceve un carattere:     s:=X.Rx  if length(s)>0 then....

  Si termina l'utilizzo:      X.Close;


  Esempio:  X.open(com1,9600,n,8,2)
            X.tx('stringa')
            s:=X.rx  if length(s)>0 then....
            X.close;

  SCOPO
  Poter accedere alla porta seriale in modo semplice.
  In lettura se non ci sono caratteri nel buffer di
  ricezione viene ritornata stringa nulla.
}


{---------------------------------------------------------------------------}
{ Funzioni di supporto per le stringhe
{---------------------------------------------------------------------------}

function Spaces(lu:integer):string;
function Lset(const s:string; lu:integer):string;
function Rset(const s:string; lu:integer):string;
function Lefts(const s:string; lu:integer):string;
function Rights(const s:string; lu:integer):string;
function Mids(const s:string; sta,lu:integer):string;
function DelSpace(const s:string):string;
function BinToInt(const s:string):integer;
function HexToInt(const s:string):integer;
function IntToBin(v,dig:integer):string;
function Estract(var s:string):string;
function Look(const s:string):string;

{---------------------------------------------------------------------------}
{ Funzioni di supporto per la matematica
{---------------------------------------------------------------------------}

function Tan(a:extended):extended;
function ArcSin(a:extended):extended;
function ArcCos(a:extended):extended;
function Log10(a:real):real;
function Log2(a:real):real;
function Exp10(a:real):real;
function Exp2(a:real):real;
function Power(x,y:extended):extended;
function Radix(x,y:extended):extended;

{---------------------------------------------------------------------------}
{ Funzioni di supporto per l'hardware
{---------------------------------------------------------------------------}

procedure StartTime;
function  Elapsed:integer;

function  Inp(ADDR:word):byte;
procedure Out(ADDR:word; B:byte);


implementation

var
  ActualTime:cardinal;


{---------------------------------------------------------------------------}
{ Metodi classe TListaStringhe                                              }
{---------------------------------------------------------------------------}

procedure TListaStringhe.init;
begin
  primo:=nil;
  ultimo:=nil;
  count:=0;
end;


procedure TListaStringhe.add(const s:string);
var pbak:PElementoListaStringhe;
begin
  if count=0 then  {se è il primo elemento inserito}
  begin
      new(primo);
      primo^.s:=s;
      primo^.prec:=nil;
      primo^.succ:=nil;
      ultimo:=primo;
      inc(count);
  end
  else
  begin
      pbak:=ultimo;
      new(ultimo);
      ultimo^.s:=s;
      ultimo^.prec:=pbak;
      ultimo^.succ:=nil;
      pbak^.succ:=ultimo;
      inc(count);
  end;
end;


function  TListaStringhe.str(n:integer):string;
var s:string; h:integer; p:PElementoListaStringhe;
begin
    s:='';
    if (n<=count) and (n>0) then
    begin
        p:=primo;
        for h:=2 to n do p:=p^.succ;
        s:=p^.s;
    end;
    result:=s;
end;


procedure TListaStringhe.clear;
var bakp:PElementoListaStringhe;
begin
  while count>0 do
  begin
      bakp:=ultimo^.prec;
      dispose(ultimo);
      ultimo:=bakp;
      dec(count);
  end;
  TlistaStringhe.init;
end;


procedure TListaStringhe.done;
begin
  TListaStringhe.clear;
  TlistaStringhe.init;
end;


procedure TListaStringhe.imp(n:integer; const s:string);
var h:integer; p:PElementoListaStringhe;
begin
  if n>count then
  begin
      for h:=1 to n-count do TListaStringhe.add('');
      ultimo^.s:=s;
  end
  else
      if n>0 then
      begin
          p:=primo;
          for h:=2 to n do p:=p^.succ;
          p^.s:=s;
      end;
end;


procedure TListaStringhe.insert(n:integer; const s:string);
var h:integer; p,bakp:PElementoListaStringhe;
begin
  if n>count then
  begin
      for h:=1 to n-count do TListaStringhe.add('');
      ultimo^.s:=s;
  end
  else
      if n=1 then
      begin
          bakp:=primo;
          new(primo);
          primo^.s:=s;
          primo^.prec:=nil;
          primo^.succ:=bakp;
          bakp^.prec:=primo;
          inc(count);
      end
      else
          if n>0 then
          begin
              p:=primo;
              for h:=2 to n do p:=p^.succ;
              bakp:=p;
              new(p);
              p^.s:=s;
              p^.prec:=bakp^.prec;
              p^.succ:=p^.prec^.succ;
              p^.prec^.succ:=p;
              p^.succ^.prec:=p;
              inc(count);
          end;
end;


procedure TListaStringhe.delete(n:integer);
var h:integer; p,bakp:PElementoListaStringhe;
begin
  if (n>0) and (n<=count) then
  begin
      if n=1 then
      begin
          bakp:=primo^.succ;
          dispose(primo);
          dec(count);
          if count>0 then
          begin
              primo:=bakp;
              primo^.prec:=nil;
          end
          else
              TListaStringhe.init;
      end
      else
          if n=count then
          begin
              bakp:=ultimo^.prec;
              dispose(ultimo);
              dec(count);
              if count>0 then
              begin
                  ultimo:=bakp;
                  ultimo^.succ:=nil;
              end
              else
                  TListaStringhe.init;
          end
          else
          begin
              p:=primo;
              for h:=2 to n do p:=p^.succ;
              p^.prec^.succ:=p^.succ;
              p^.succ^.prec:=p^.prec;
              dispose(p);
              dec(count);
          end;
  end;
end;


procedure TListaStringhe.LoadFromFile(const s:string);
var R:TTextReader; s2:string;
begin
    R.init(s);
    while not R.eod do
    begin
        R.rd(s2);
        TListaStringhe.add(s2);
    end;
    R.done;
end;


procedure TListaStringhe.SaveToFile(const s:string);
var f1:Text; h:integer; p:PElementoListaStringhe;
begin
  assign(f1,s);
  {$I-}
  rewrite(f1);
  p:=primo;
  for h:=1 to count do
  begin
      writeln(f1,p^.s);
      p:=p^.succ;
  end;
  close(f1);
  {$I+}
end;

{---------------------------------------------------------------------------}
{ Metodi classe TTextReader                                                 }
{---------------------------------------------------------------------------}

procedure TTextReader.init(const nf:string);
begin
  assign(f1,nf);
  {$I-}
  reset(f1);
  {$I+}
  eod := not (IOresult = 0);
  if not eod then eod:=eof(f1);
end;


procedure TTextReader.rd(var s:string);
begin
  if eod then
      s:=''
  else
  begin
      readln(f1,s);
      eod:=eof(f1);
  end;
end;


procedure TTextReader.done;
begin
  {$I-}
  close(f1);
  {$I+}
end;

{---------------------------------------------------------------------------}
{ Metodi classe TDataReader                                                 }
{---------------------------------------------------------------------------}

procedure TDataReader.ScomponiRiga(var s:string);
var p:integer; s2:string;  c:char;
begin
    if length(s)=0 then exit;  // Scarta stringhe vuote
    p:=pos('//',s);
    if p=1 then s:='' else if p>1 then s:=copy(s,1,p-1); // Scarta i commenti
    s:=delspace(s);    // Toglie blank iniziali e finali
    if length(s)=0 then exit;  // Scarta stringhe senza caratteri validi

    s2:='';
    p:=1;
    while p<=length(s) do
    begin
        c:=s[p];
        if c='|' then
        begin
            if (length(s2)>0) and (s2[1]=':') then s2:=uppercase(s2);
            StringList.add(delspace(s2));
            inc(ele);
            inc(p);
            s2:='';
        end
        else
        begin
            s2:=s2+c;
            inc(p);
            if p>length(s) then
            begin
                if (length(s2)>0) and (s2[1]=':') then s2:=uppercase(s2);
                StringList.add(delspace(s2));
                inc(ele);
            end;
        end;
    end; {while}
    if ele=0 then eod:=true else eod:=false;
end;


procedure TDataReader.init(const nf:string);
var s:string;
begin
  StringList.init;
  ele:=0; punt:=0;
  TextReader.init(nf);
  while not TextReader.eod do
  begin
      TextReader.rd(s);
      ScomponiRiga(s);
  end;
  TextReader.done;
end;


procedure TDataReader.rdstr(var s:string);
var s2:string; fine:boolean;
begin
    if (ele=0) or (punt>ele) then s:=''
    else
    begin
        fine:=false;
        s:='';
        while not fine do
        begin
            inc(punt);
            if punt>ele then
            begin
                s:='';
                fine:=true;
                eod:=true;
            end
            else
            begin
                s2:=StringList.str(punt);
                if not ( (length(s2)>0) and (s2[1]=':') ) then
                begin
                    s:=s2;
                    fine:=true;
                    if punt=ele then eod:=true;
                end;
            end;
        end; {while}
    end;
end;


procedure TDataReader.rdint(var v:integer);
var a:integer; s:string; c:char;
begin
    rdstr(s);
    a:=length(s);
    if a>0 then c:=upcase(s[a]) else c:=' ';
    if Upcase(c)='H' then
    begin
        delete(s,a,1);
        v:=HexToInt(s);
    end
    else if c='B' then
    begin
        delete(s,a,1);
        v:=BinToInt(s);
    end
    else
    begin
        val(s,v,a);
        if a<>0 then v:=0;
    end;
end;


procedure TDataReader.rdreal(var v:extended);
var res:integer; s:string;
begin
    rdstr(s);
    val(s,v,res);
    if res<>0 then v:=0;
end;


procedure TDataReader.restore(const s:string);
var s2:string; fine:boolean;
begin
    punt:=0;
    if s<>'' then
    begin
        s2:=':'+uppercase(s);
        fine:=false;
        while not fine do
        begin
            inc(punt);
            if punt>ele then
            begin
                fine:=true;
                eod:=true;
            end
            else
                if StringList.str(punt)=s2 then
                begin
                    dec(punt);
                    fine:=true;
                end;
        end; {while}
    end;
end;


procedure TDataReader.done;
begin
end;


{-------------------------------------------------------------------------}
{ Metodi classe TPortaSeriale
{-------------------------------------------------------------------------}

procedure TPortaSeriale.open(port:TComPorte; vel:integer;
                             par:TComparita; bit,sbit:integer);
var  ok:boolean; sport:string;
begin
  ComIsOpen:=false;

  if port=com1 then sport:='COM1' else sport:='COM2';
  ComHandle := CreateFile(PChar(sport), GENERIC_READ or GENERIC_WRITE,
                          0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if ComHandle=0 then exit;

  ok:=SetupComm(ComHandle, 8192, 8192);
  if not ok then exit;

  ComDCB.DCBlength:=SizeOf(Tdcb);

  if vel=110       then ComDCB.BaudRate:= CBR_110
  else if vel=300  then ComDCB.BaudRate:= CBR_300
  else if vel=600  then ComDCB.BaudRate:= CBR_600
  else if vel=1200 then ComDCB.BaudRate:= CBR_1200
  else if vel=2400 then ComDCB.BaudRate:= CBR_2400
  else if vel=4800 then ComDCB.BaudRate:= CBR_4800
  else if vel=9600 then ComDCB.BaudRate:= CBR_9600;

  ComDCB.Flags:=12305;
  ComDCB.wReserved:=0;
  ComDCB.XonLim:=6553;
  ComDCB.XoffLim:=65535;

  if bit=7      then ComDCB.ByteSize:=7
  else if bit=8 then ComDCB.ByteSize:=8;

  if par=n      then ComDCB.Parity:=0
  else if par=o then ComDCB.Parity:=1
  else if par=e then ComDCB.Parity:=2
  else if par=m then ComDCB.Parity:=3
  else if par=s then ComDCB.Parity:=4;

  if sbit=1      then ComDCB.StopBits:=0
  else if sbit=2 then ComDCB.StopBits:=2;

  ComDCB.XonChar:=#17;
  ComDCB.XoffChar:=#19;
  ComDCB.ErrorChar:='?';
  ComDCB.EofChar:=#0;
  ComDCB.EvtChar:=#0;
  ComDCB.wReserved1:=65;
  ok:=SetCommState(ComHandle, ComDCB);
  if not ok then exit;

  ComTimeout.ReadIntervalTimeout:=2;
  ComTimeout.ReadTotalTimeoutMultiplier:=0;
  ComTimeout.ReadTotalTimeoutConstant:=1;
  ComTimeout.WriteTotalTimeoutMultiplier:=2;
  ComTimeout.WriteTotalTimeoutConstant:=2;
  ok:=SetCommTimeouts(ComHandle,ComTimeout);
  if not ok then exit;

  ComIsOpen:=true;
end;

{-------------------------------------------------------------------------}

procedure TPortaSeriale.close;
begin
    if ComIsOpen then CloseHandle(ComHandle);
    ComIsOpen:=false;
end;

{-------------------------------------------------------------------------}

procedure TPortaSeriale.tx(const s:string);
var b:byte; h,l,res:integer;
begin
    l:=length(s);
    for h:=1 to l do
    begin
        b:=ord(s[h]);
        WriteFile(ComHandle, b, 1, res, nil);
    end;
end;

{-------------------------------------------------------------------------}

function TPortaSeriale.rx:string;
var res: integer; b:byte; s:string;
begin
  ReadFile(ComHandle, b, 1, res, nil);
  if res=1 then s:=chr(b) else s:='';
  result:=s;
end;


{---------------------------------------------------------------------------}
{ Funzioni e procedure
{---------------------------------------------------------------------------}


function spaces(lu:integer):string;
begin
  if lu<=0 then result:='' else result:=stringofchar(' ',lu);
end;

{---------------------------------------------------------------------------}

function lset(const s:string; lu:integer):string;
var a:integer; s2:string;
begin
  s2:='';
  if lu>0 then
  begin
      a:=length(s);
      if a>lu then        s2:=copy(s,1,lu)
      else if a<lu then   s2:=s+spaces(lu-a)
      else                s2:=s;
  end;
  result:=s2;
end;

{---------------------------------------------------------------------------}

function rset(const s:string; lu:integer):string;
var a:integer; s2:string;
begin
  s2:='';
  if lu>0 then
  begin
      a:=length(s);
      if a>lu then       s2:=copy(s,a-lu+1,lu)
      else if a<lu then  s2:=spaces(lu-a)+s
      else               s2:=s;
  end;
  result:=s2;
end;


{---------------------------------------------------------------------------}

function lefts(const s:string; lu:integer):string;
var a:integer; s2:string;
begin
  s2:='';
  if lu>0 then
  begin
      a:=length(s);
      if a<lu then s2:=s  else  s2:=copy(s,1,lu);
  end;
  result:=s2;
end;

{---------------------------------------------------------------------------}

function rights(const s:string; lu:integer):string;
var a:integer; s2:string;
begin
  s2:='';
  if lu>0 then
  begin
      a:=length(s);
      if a<lu then  s2:=s   else  s2:=copy(s,a-lu+1,lu);
  end;
  result:=s2;
end;

{---------------------------------------------------------------------------}

function mids(const s:string; sta,lu:integer):string;
var a:integer; s2:string;
begin
  s2:='';
  a:=length(s);
  if (sta>0) and (sta<=a) and (lu>=0) then
      if sta+lu-1 <= a then s2:=copy(s,sta,lu)  else s2:=copy(s,sta,a-sta+1);
  result:=s2;
end;

{---------------------------------------------------------------------------}

function delspace(const s:string):string;
var a:integer; s2:string;
begin
  s2:='';
  if length(s)>0 then
  begin
      s2:=s;
      while (length(s2)>0) and (s2[1]=' ') do delete(s2,1,1);
      while (length(s2)>0) and (s2[length(s2)]=' ') do
          delete(s2,length(s2),1);
  end;
  result:=s2;
end;

{---------------------------------------------------------------------------}
{  Converte una stringa binaria di '0' e '1' in valore integer. Se la
{  stringa e' nulla o contiene caratteri non validi viene ritornato
{  il valore 0.
{---------------------------------------------------------------------------}

function BinToInt(const s:string):integer;
var v,a,h:integer;
begin
    v:=0;
    a:=length(s);
    for h:=1 to a do
    begin
        v := v + v;
        if s[h]='1' then
            v := v + 1
        else if s[h]<>'0' then
        begin
            v:=0;
            break;
        end;
    end;
    result:=v;
end;

{---------------------------------------------------------------------------}
{  Converte una stringa esadecimale in valore integer. Se la stringa
{  e' nulla o contiene caratteri non validi viene ritornato il valore 0.
{---------------------------------------------------------------------------}

function HexToInt(const s:string):integer;
var v,a,h:integer; c:char;
begin
    v:=0;
    a:=length(s);
    for h:=1 to a do
    begin
        v := v * 16;
        c:=upcase(s[h]);
        if (c>='0') and (c<='9')      then v := v + ord(s[h]) - 48
        else if (c>='A') and (c<='F') then v := v + ord(s[h]) - 55
        else if (c>='a') and (c<='f') then v := v + ord(s[h]) - 87
        else
        begin
            v:=0;
            break;
        end;
    end;
    result:=v;
end;

{---------------------------------------------------------------------------}
{ Converte il valore integer di V in una stringa binaria di '0' e '1' lunga
{ DIG caratteri aggiungendo eventuali zeri non significativi in testa
{ alla stringa se la sua lunghezza e' inferiore a DIG. Se si passa un valore
{ negativo, o DIG=0, o la stringa binaria eccede il valore di DIG allora
{ viene ritornata stringa nulla.
{---------------------------------------------------------------------------}

function IntToBin(v,dig:integer):string;
var s:string;  a,b:integer;
begin
    s:='';
    if (v>=0) and (dig>0) then
    begin
        a:=v;
        while a>0 do
        begin
            if (a and 1) = 1 then s:='1'+s else s:='0'+s;
            a:=a div 2;
        end;
        a:=length(s);
        if a<dig then s:=stringofchar('0',dig-a)+s  else if a>dig then s:='';
    end;
    result:=s;
end;

{---------------------------------------------------------------------------}
{  Estrae una parola da una stringa (cancellandola dalla stringa stessa)
{  Una parola e' un insieme di caratteri contigui >=chr33 (!)
{  Es: S='  ab cd ef '  -> estract -> ritorna  'ab'  e   S=' cd ef '
{      S=' cd ef '      -> estract -> ritorna  'cd'  e   S=' ef '
{      S=' ef '         -> estract -> ritorna  'ef'  e   S=''
{      S=''             -> estract -> ritorna  ''    e   S=''
{---------------------------------------------------------------------------}

function Estract(var s:string):string;
var r:string; p,ls:integer; fine:boolean; c:char;
begin
  r:='';            {stringa del risultato}
  ls:=length(s);    {lungh. stringa input}
  p:=1;             {puntatore ai caratteri della stringa S}
  fine:=false;
  while (not fine) and (p<=ls) do
  begin
      c:=s[p];
      if c<'!' then   begin   if length(r)>0 then fine:=true;    end
               else   r:=r+c;
      inc(p);
  end;
  if ls>0 then delete(s,1,p-1);
  result:=r;
end;


{---------------------------------------------------------------------------}
{  Ritorna la prossima parola in una stringa (senza cancellarla dalla str)
{  Una parola e' un insieme di caratteri contigui >=chr33 (!)
{  Es: S='  ab cd ef '  -> look -> ritorna  'ab'  e   S='  ab cd ef '
{---------------------------------------------------------------------------}

function Look(const s:string):string;
var r:string; p,ls:integer; fine:boolean; c:char;
begin
  r:='';            {stringa del risultato}
  ls:=length(s);    {lungh. stringa input}
  p:=1;             {puntatore ai caratteri della stringa S}
  fine:=false;
  while (not fine) and (p<=ls) do
  begin
      c:=s[p];
      if c<'!' then   begin   if length(r)>0 then fine:=true;    end
               else   r:=r+c;
      inc(p);
  end;
  result:=r;
end;

{---------------------------------------------------------------------------}
{ Funzioni matematiche
{---------------------------------------------------------------------------}

function tan(a:extended):extended;
begin
  result:=sin(a)/cos(a);
end;


function arcsin(a:extended):extended;
begin
  result:=arctan(a/sqrt(1-sqr(a)));
end;


function arccos(a:extended):extended;
begin
  result:=arctan(sqrt(1-sqr(a))/a);
end;


function log10(a:real):real;
begin
  result:=ln(a)/ln(10);
end;


function log2(a:real):real;
begin
  result:=ln(a)/ln(2);
end;


function exp10(a:real):real;
begin
  result:=exp(ln(10)*a)
end;


function exp2(a:real):real;
begin
  result:=exp(ln(2)*a)
end;

{---------------------------------------------------------------------------}
{  Calcola X elevato alla Y (solo per X positiva)
{---------------------------------------------------------------------------}

function power(x,y:extended):extended;
begin
  if x>0 then result:=exp(ln(x)*y) else result:=0;
end;

{---------------------------------------------------------------------------}
{ Calcola radice Y di X (solo per X positiva>0 e Y<>0)
{---------------------------------------------------------------------------}

function radix(x,y:extended):extended;
begin
  if (x>0) and (y<>0) then result:=exp(ln(x)/y) else result:=0;
end;

{---------------------------------------------------------------------------}
{  Accesso alle porte di I/O del PC (Solo Win/95/98)
{---------------------------------------------------------------------------}

function inp(ADDR:word):byte;
var B:byte;
begin
  asm
     mov dx,ADDR
     in al,dx
     mov B,al
  end;
  result:=B;
end;


procedure out(ADDR:word; B:byte);
begin
  asm
     mov dx,ADDR
     mov al,B
     out dx,al
  end;
end;

{-------------------------------------------------------------------------}
{  Funzioni per il controllo preciso del tempo trascorso in millisecondi
{-------------------------------------------------------------------------}

procedure StartTime;
begin
  ActualTime:=gettickcount;
end;


function Elapsed:integer;
begin
  result:=gettickcount-ActualTime;
end;

{-------------------------------------------------------------------------}

end.