home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.wwiv.com
/
ftp.wwiv.com.zip
/
ftp.wwiv.com
/
pub
/
MISC
/
TGARTS.ZIP
/
TGDEV309.ZIP
/
BITPLANE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1997-11-06
|
3KB
|
95 lines
{****************************************************************************)
(*> <*)
(*> 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.