{****************************************************************************)
(*>                                                                        <*)
(*>                    Telegard Bulletin Board System                      <*)
(*>          Copyright 1997 by Tim Strike.  All rights reserved.           <*)
(*>                                                                        <*)
(*>  Module name:       BITPLANE.PAS                                       <*)
(*>  Module purpose:    Bitplanes (compressed boolean planes)              <*)
(*>                                                                        <*)
(****************************************************************************}

{$A+,B+,E-,F+,I-,N-,O+,V-}

unit bitplane;

interface

const maxbitplane = 4095;
type  absbitplane = array [0..maxbitplane] of byte;
type  __bitplane = ^absbitplane;

procedure setbitplane( bp:__bitplane; absbit:integer; toggleon:boolean );
procedure togglebitplane( bp:__bitplane; absbit:integer );
function  inbitplane( bp:__bitplane; absbit:integer ) : boolean;
procedure insertbitplane( bp:__bitplane; absbit:integer; size:integer; num:byte );
procedure deletebitplane( bp:__bitplane; absbit:integer; size:integer );

implementation

const left   : array[0..7] of byte = (0,128,192,224,240,248,252,254);
      righti : array[0..7] of byte = (255,127,63,31,15,7,3,1);
      right  : array[0..7] of byte = (127,63,31,15,7,3,1,0);

procedure setbitplane( bp:__bitplane; absbit:integer; toggleon:boolean );
var ofs:integer; 
    bit:byte;
begin
{$R-}
bit := absbit mod 8;
ofs := absbit div 8;
bp^[ofs] := (bp^[ofs] and left[bit]) or (bp^[ofs] and right[bit]);
if toggleon then bp^[ofs] := bp^[ofs] or (128 shr bit);
{$R+}
end;

procedure togglebitplane( bp:__bitplane; absbit:integer );
begin
bp^[ absbit div 8 ] := bp^[ absbit div 8 ] xor (128 shr (absbit mod 8));
end;

function inbitplane( bp:__bitplane; absbit:integer ) : boolean;
var bit:byte;
begin
bit := 128 shr (absbit mod 8);
inbitplane := (bp^[ absbit div 8 ] and bit) = bit;
end;

procedure insertbitplane( bp:__bitplane; absbit:integer; size:integer; num:byte );
var bit,nshl,nshr:byte;
    skip,i,j:integer;
begin
{$R-}
bit := absbit mod 8;
i   := absbit div 8;
if (num >= 8) then
   begin
   skip := (num div 8);
   for j := size-1 downto i+1 do
      bp^[j] := bp^[j-skip];
   end;
nshr := num mod 8;
nshl := (8 - nshr);
for j := size-1 downto i+1 do
   bp^[j] := (bp^[j] shr nshr) or (bp^[j-1] shl nshl);
bp^[i] := (bp^[i] and left[bit]) or ((bp^[i] and righti[bit]) shr nshr);
for j := absbit to absbit+num-1 do
   bp^ [ j div 8 ] := bp^ [ j div 8 ] or (128 shr (j mod 8));
{$R+}
end;

procedure deletebitplane( bp:__bitplane; absbit:integer; size:integer );
var bit:byte;
    i,j:integer;
begin
{$R-}
bit := absbit mod 8;
i   := absbit div 8;
bp^[i] := (bp^[i] and left[bit]) or ((bp^[i] and right[bit]) shl 1);
if (i <> size) then bp^[i] := bp^[i] or (bp^[i+1] shr 7);
for j := i+1 to size-1 do
   bp^[j] := (bp^[j] shl 1) or (bp^[j+1] shr 7);
{$R+}
end;

end.