(*
bit_io2
(c) David Pethes (imcold)

kniznica pre bitovy pristup k suborom
*)
unit bitio;
{$mode objfpc}

interface

type
  bitio_file_t = record
      f: file;
      file_size: longword;
      mode:   byte;
      buffer: PByte;                 //buffer - 1 bajt bufferu = 1 bit vo vstupe/vystupe
      buffer_size: integer;          //velkost buffera v bajtoch / dlzka bufferu v bitoch
      pos:  integer;                 //aktualny bajt bufferu
      mask: byte;
      current_byte: byte;
  end;
  

procedure bitio_open_file_read  (var bf: bitio_file_t; name: string; buffer_byte_length: longword);
procedure bitio_open_file_write (var bf: bitio_file_t; name: string; buffer_byte_length: longword);
procedure bitio_close_file    (var bf: bitio_file_t);
function  bitio_get_file_size (var bf: bitio_file_t): longword;

procedure bitio_read  (var bf: bitio_file_t; var bit: integer);   inline;
procedure bitio_read_bits (var bf: bitio_file_t; var bits: longword; count: longword); inline;

procedure bitio_write (var bf: bitio_file_t; bit: byte);          inline;
procedure bitio_write_str (var bf: bitio_file_t; bitstr: string); inline;
procedure bitio_write_bits (var bf: bitio_file_t; bits: longword; count: longword); inline;

procedure bitio_fill_buffer  (var bf: bitio_file_t);  //kvoli read/write inline je rychlejsie, ak su uvedene aj v interface sekcii
procedure bitio_flush_buffer (var bf: bitio_file_t);


implementation

uses
  sysutils;

const
  BITIO_MODE_READ  = 1;
  BITIO_MODE_WRITE = 2;

(*******************************************************************************
  spolocne
*******************************************************************************)
function bitio_get_file_size (var bf: bitio_file_t): longword;
begin
  if (bf.mode = BITIO_MODE_READ) then
      Result := bf.file_size
  else
      Result := 0;
end;


procedure bitio_close_file (var bf: bitio_file_t);
begin
  if (bf.mode = BITIO_MODE_WRITE) then bitio_flush_buffer(bf);
  Freemem (bf.buffer);
  CloseFile (bf.f);
end;



(*******************************************************************************
  bitio bitovy zapis do suboru
*******************************************************************************)
procedure bitio_open_file_write (var bf: bitio_file_t; name: string; buffer_byte_length: longword) ;
begin
  bf.mode := BITIO_MODE_WRITE;
  AssignFile (bf.f, name);
  Rewrite (bf.f, 1);
  if buffer_byte_length = 0 then
      bf.buffer_size := 1
  else
      bf.buffer_size := buffer_byte_length;
  bf.buffer := GetMem (bf.buffer_size);
  bf.pos  := 0;
  bf.mask := $80;
  bf.current_byte := 0;
end;


procedure bitio_flush_buffer (var bf: bitio_file_t);
begin
  //ak nie je posledny byte v bufferi
  if (bf.mask <> $80) then begin
      bf.buffer[bf.pos] := bf.current_byte;
      bf.pos += 1;
  end;
  BlockWrite (bf.f, bf.buffer^, bf.pos) ;
end;


procedure bitio_write (var bf: bitio_file_t; bit: byte);
begin
  if bit = 1 then bf.current_byte := bf.current_byte or bf.mask;
  bf.mask := bf.mask shr 1;
  
  if bf.mask = 0 then begin
      bf.buffer[bf.pos] := bf.current_byte;
      inc(bf.pos, 1);
      if bf.pos = bf.buffer_size then begin
          BlockWrite (bf.f, bf.buffer^, bf.pos) ;
          bf.pos := 0;
      end;
      bf.mask := $80;
      bf.current_byte := 0;
  end;
end;


procedure bitio_write_bits (var bf: bitio_file_t; bits: longword; count: longword);
var
  c: longword;
  mask: longword;
begin
  mask := 1 shl (count-1);
  for c := 1 to count do begin
      if (bits and mask) = 0 then
          bitio_write(bf, 0)
      else
          bitio_write(bf, 1);
      mask := mask shr 1;
  end
end;


procedure bitio_write_str (var bf: bitio_file_t; bitstr: string);
var
  p: integer;
begin
  for p := 1 to Length(bitstr) do
      if bitstr[p] = '0' then
          bitio_write(bf, 0)
      else
          bitio_write(bf, 1);
end;



(*******************************************************************************
  bitio nacitavanie zo suboru po bitoch
*******************************************************************************)
procedure bitio_open_file_read (var bf: bitio_file_t; name: string; buffer_byte_length: longword) ;
begin
  bf.mode := BITIO_MODE_READ;
  AssignFile (bf.f, name);
  Reset (bf.f, 1);
  bf.file_size := longword( FileSize (bf.f) );

  if buffer_byte_length = 0 then
      bf.buffer_size := 1
  else  if buffer_byte_length > bf.file_size then
      bf.buffer_size := bf.file_size
  else
      bf.buffer_size := buffer_byte_length;
  bf.buffer := GetMem (bf.buffer_size);
  bf.pos  := 0;
  bf.mask := $80;
  bitio_fill_buffer(bf);
end;


procedure bitio_fill_buffer (var bf: bitio_file_t);
var
  read_bytes: integer;
begin
  if (FilePos(bf.f) >= bf.file_size) then
      Exit    //precitany cely subor - eof?
  else if ( bf.file_size - FilePos(bf.f) ) < bf.buffer_size then
      read_bytes := bf.file_size - FilePos(bf.f)
  else
      read_bytes := bf.buffer_size;
      
  BlockRead (bf.f, bf.buffer^, read_bytes);
  bf.current_byte := bf.buffer[0];
end;


procedure bitio_read (var bf: bitio_file_t; var bit: integer);
begin
  bit := bf.mask and bf.current_byte;
  if bit > 0 then bit := 1;
  bf.mask := bf.mask shr 1;

  if bf.mask = 0 then begin
      inc(bf.pos, 1);
      if bf.pos = bf.buffer_size then begin
          bitio_fill_buffer(bf);
          bf.pos := 0;
      end;
      bf.current_byte := bf.buffer[bf.pos];
      bf.mask := $80;
  end;
end;


procedure bitio_read_bits (var bf: bitio_file_t; var bits: longword; count: longword);
var
  c: longword;
  bit: integer;
begin
  for c := 1 to count do begin
      bitio_read(bf, bit);
      bits := bits shl 1 + bit;
  end;
end;


end.