{**********************************************************************
Copyright (C) 2009 by Salvatore Licciardi

Web http://www.webalice.it/turylicciardi    eMail turylicciardi@tiscali.it

 This program is free software: you can redistribute it and/or modify it under
 the terms of the GNU General Public License as published by the Free Software
 Foundation, version 3 of the License.
 This program is distributed in the hope  that it will be useful , but WITHOUT
 ANY WARRANTY without even the implied warranty  of MERCHANTABILITY or FITNESS
 FOR A PARTICULAR PURPOSE.
 See the GNU General Public License for more details. You should have received
 a copy of the GNU General Public License along with this program. If not, see
 http://www.gnu.org/licenses/

 **********************************************************************}

{ this unit is for FreePascal 2.0.0
  this unit is for all OS

  written by: Salvatore Licciardi
  WWW page  : www.webalice.it/turylicciardi
  E-Mail    : turylicciardi@tiscali.it
  this file : www.webalice.it/turylicciardi/prog/bit.zip
              (Bit.pas, Ex_bit.pas)
  version   : 1.1.0  2007/08/18
}

unit bit;
{$H+}  // longstring

interface

uses math;

type bits=object
         public
          constructor   Init;
          constructor   Init(n:longint);
          destructor    Destroy;
          function      SetLength(n_bit:longint):boolean;
          function      Length():longint;
          function      Set_Bit(pos:longint; b:boolean):boolean;
          function      Get_Bit(pos:longint):boolean;
          function      Get_Bit_(pos:longint):char;   // ver 1.1
          function      Assign(s:string):boolean; // only '1' and '0' sequence
          function      Not_(pos:longint):boolean;
          procedure     Reverse;   // 1110 --> 0111  il primo bit diventa ultimo ...
          procedure     write;
          procedure     writeln;
          function      BitToStr():string;
          function      Extract(pos:longint):boolean;
          function      Insert(pos:longint; b:boolean):boolean;
          procedure     Not_All; // 0001 --> 1110 not bit per bit su stesso oggetto
          function      Not_():bits;
          function      And_(bit2:bits):bits;
          function      Or_(bit2:bits):bits;
          function      Xor_(bit2:bits):bits;
          function      Get_number():longint;   // ver 1.1
          procedure     Assign(n:longint);      // ver 1.1

         private
          dati: array of byte;
          num_bit:longint;
          function Decimal2Bin(numdec:longint):string;   // ver 1.1

         protected

         end;

implementation

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

destructor bits.Destroy;
begin
system.setlength(dati,0);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

constructor bits.Init;
begin
system.setlength(dati,0);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

constructor bits.Init(n:longint);
begin
if n<0 then n:=0;
SetLength(n);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function   bits.SetLength(n_bit:longint):boolean;
var i,n_byte:longint;
begin
if n_bit<0 then Exit(false)
           else SetLength:=true;
n_byte:=n_bit div 8;
if (n_bit mod 8)<>0 then inc(n_byte);
system.setlength(dati,n_byte);
for i:=num_bit+1 to n_byte*8 do Set_Bit(i,false);
num_bit:=n_bit;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function  bits.Length():longint;
begin
Length:=num_bit;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function   bits.Get_Bit(pos:longint):boolean;
var n_byte:longint;
    valore:byte;
begin
if (pos<1) or (pos>num_bit) then Exit(false);
n_byte:=pos div 8;
if (pos mod 8)<>0 then inc(n_byte);
dec(n_byte); // first position = 0

pos:=pos mod 8;
if pos=0 then pos:=8;

valore:=dati[n_byte] div (2**(pos-1));  // tolgo i bit di destra
Get_Bit:=((valore mod 2)=1);            // se e' pari, e' false; altrimenti true
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function   bits.Get_Bit_(pos:longint):char;
begin
if bits.Get_Bit(pos) then exit('1')
                     else exit('0');
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}


function   bits.Set_Bit(pos:longint; b:boolean):boolean;
var n_byte:longint;
    valore:byte;
begin
if (pos<1) or (pos>num_bit) then Exit(false)
                            else Set_Bit:=true;
n_byte:=pos div 8;
if (pos mod 8)<>0 then inc(n_byte);
dec(n_byte); // first position = 0

pos:=pos mod 8;
if pos=0 then pos:=8;

valore:=dati[n_byte];
if b then valore:=valore or (2**(pos-1))
     else valore:=valore and ( ((2**8)-1)-(2**(pos-1)) );
dati[n_byte]:=valore;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function bits.Not_(pos:longint):boolean;
begin
if (pos<1) or (pos>num_bit) then Exit(false)
                            else Not_:=true;
if Get_Bit(pos) then Set_Bit(pos,false)
                else Set_Bit(pos,true);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure bits.Reverse;   // 1110 --> 0111
var b:boolean;
    i:longint;
begin
for i:=1 to num_bit div 2 do
    begin
    b:=Get_Bit(i);
    Set_Bit(i,Get_Bit(num_bit - i +1));
    Set_Bit(num_bit - i +1,b);
    end;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function bits.Get_number():longint;   {converte da binario a numero}
var i,total:longint;
    due:real;
begin
due:=0.5;
total:=0;
for i:=1 to num_bit do
    begin
    due:=due*2;
    if get_bit(i) then total:=total+trunc(due);
    end;
exit(total);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function bits.Decimal2Bin(numdec:longint):string;   {converte da decimale a binario}
var s:string;
begin
s:='';
if numdec<0 then numdec:=-numdec;
repeat
 s:=char((numdec mod 2)+48)+s;
 numdec:=numdec div 2;
until numdec=0;
exit(s);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure    bits.Assign(n:longint);
begin
Assign(bits.Decimal2Bin(n));
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function    bits.Assign(s:string):boolean;
var i:longint;
begin
for i:=1 to system.length(s) do
    if (s[i]<>'0')and(s[i]<>'1') then Exit(false);
SetLength(0);
if system.length(s)=0 then Exit(false);
assign:=true;
SetLength(system.length(s));
for i:=system.length(s) downto 1 do Set_Bit(i,(s[system.length(s)-i+1]='1'));
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function   bits.BitToStr():string;
var i:longint;
    s:string;
begin
s:='';
for i:=1 to length() do
    if Get_Bit(i) then s:='1'+s
                  else s:='0'+s;
BitToStr:=s;
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure    bits.write;
begin
system.write(BitToStr());
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure    bits.writeln;
begin
system.writeln(BitToStr());
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function bits.Extract(pos:longint):boolean;
var i:longint;
begin
if (pos<1) or (pos>num_bit) then Exit(false);
Extract:=Get_Bit(pos);
for i:=pos to num_bit-1 do Set_Bit(i,Get_Bit(i+1));
dec(num_bit);
if num_bit mod 8 =0 then system.setlength( dati,max(system.length(dati)-1,0) );
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function bits.Insert(pos:longint; b:boolean):boolean; // shift
var i:longint;
begin
if (pos<1) then Exit(false)
           else Insert:=true;
if (pos>num_bit) then SetLength(pos-1);
SetLength(num_bit+1);
for i:=num_bit-1 downto pos do Set_Bit(i+1,Get_Bit(i));
Set_Bit(pos,b);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure bits.Not_All;
var i:longint;
begin
for i:=1 to num_bit do Not_(i);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function bits.Not_():bits;
var i:longint;
     new_bit:bits;
begin
new_bit.init(num_bit);
for i:=1 to num_bit do new_bit.set_Bit(i,not get_Bit(i));
exit(new_bit);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function bits.And_(bit2:bits):bits;
var i:longint;
     new_bit:bits;
begin
new_bit.init(min(num_bit,bit2.length()));
for i:=1 to new_bit.length() do new_bit.set_Bit(i, get_Bit(i) and bit2.get_Bit(i));
exit(new_bit);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function bits.Or_(bit2:bits):bits;
var i:longint;
     new_bit:bits;
begin
new_bit.init(max(num_bit,bit2.length()));
for i:=1 to new_bit.length() do new_bit.set_Bit(i, get_Bit(i) or bit2.get_Bit(i));
exit(new_bit);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

function bits.Xor_(bit2:bits):bits;
var i:longint;
     new_bit:bits;
begin
new_bit.init(max(num_bit,bit2.length()));
for i:=1 to new_bit.length() do new_bit.set_Bit(i, get_Bit(i) xor bit2.get_Bit(i));
exit(new_bit);
end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

end.
