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 >
Pascal/Delphi Source File  |  1997-11-06  |  3KB  |  95 lines
  1. {****************************************************************************)
  2. (*>                                                                        <*)
  3. (*>                    Telegard Bulletin Board System                      <*)
  4. (*>          Copyright 1997 by Tim Strike.  All rights reserved.           <*)
  5. (*>                                                                        <*)
  6. (*>  Module name:       BITPLANE.PAS                                       <*)
  7. (*>  Module purpose:    Bitplanes (compressed boolean planes)              <*)
  8. (*>                                                                        <*)
  9. (****************************************************************************}
  10.  
  11. {$A+,B+,E-,F+,I-,N-,O+,V-}
  12.  
  13. unit bitplane;
  14.  
  15. interface
  16.  
  17. const maxbitplane = 4095;
  18. type  absbitplane = array [0..maxbitplane] of byte;
  19. type  __bitplane = ^absbitplane;
  20.  
  21. procedure setbitplane( bp:__bitplane; absbit:integer; toggleon:boolean );
  22. procedure togglebitplane( bp:__bitplane; absbit:integer );
  23. function  inbitplane( bp:__bitplane; absbit:integer ) : boolean;
  24. procedure insertbitplane( bp:__bitplane; absbit:integer; size:integer; num:byte );
  25. procedure deletebitplane( bp:__bitplane; absbit:integer; size:integer );
  26.  
  27. implementation
  28.  
  29. const left   : array[0..7] of byte = (0,128,192,224,240,248,252,254);
  30.       righti : array[0..7] of byte = (255,127,63,31,15,7,3,1);
  31.       right  : array[0..7] of byte = (127,63,31,15,7,3,1,0);
  32.  
  33. procedure setbitplane( bp:__bitplane; absbit:integer; toggleon:boolean );
  34. var ofs:integer; 
  35.     bit:byte;
  36. begin
  37. {$R-}
  38. bit := absbit mod 8;
  39. ofs := absbit div 8;
  40. bp^[ofs] := (bp^[ofs] and left[bit]) or (bp^[ofs] and right[bit]);
  41. if toggleon then bp^[ofs] := bp^[ofs] or (128 shr bit);
  42. {$R+}
  43. end;
  44.  
  45. procedure togglebitplane( bp:__bitplane; absbit:integer );
  46. begin
  47. bp^[ absbit div 8 ] := bp^[ absbit div 8 ] xor (128 shr (absbit mod 8));
  48. end;
  49.  
  50. function inbitplane( bp:__bitplane; absbit:integer ) : boolean;
  51. var bit:byte;
  52. begin
  53. bit := 128 shr (absbit mod 8);
  54. inbitplane := (bp^[ absbit div 8 ] and bit) = bit;
  55. end;
  56.  
  57. procedure insertbitplane( bp:__bitplane; absbit:integer; size:integer; num:byte );
  58. var bit,nshl,nshr:byte;
  59.     skip,i,j:integer;
  60. begin
  61. {$R-}
  62. bit := absbit mod 8;
  63. i   := absbit div 8;
  64. if (num >= 8) then
  65.    begin
  66.    skip := (num div 8);
  67.    for j := size-1 downto i+1 do
  68.       bp^[j] := bp^[j-skip];
  69.    end;
  70. nshr := num mod 8;
  71. nshl := (8 - nshr);
  72. for j := size-1 downto i+1 do
  73.    bp^[j] := (bp^[j] shr nshr) or (bp^[j-1] shl nshl);
  74. bp^[i] := (bp^[i] and left[bit]) or ((bp^[i] and righti[bit]) shr nshr);
  75. for j := absbit to absbit+num-1 do
  76.    bp^ [ j div 8 ] := bp^ [ j div 8 ] or (128 shr (j mod 8));
  77. {$R+}
  78. end;
  79.  
  80. procedure deletebitplane( bp:__bitplane; absbit:integer; size:integer );
  81. var bit:byte;
  82.     i,j:integer;
  83. begin
  84. {$R-}
  85. bit := absbit mod 8;
  86. i   := absbit div 8;
  87. bp^[i] := (bp^[i] and left[bit]) or ((bp^[i] and right[bit]) shl 1);
  88. if (i <> size) then bp^[i] := bp^[i] or (bp^[i+1] shr 7);
  89. for j := i+1 to size-1 do
  90.    bp^[j] := (bp^[j] shl 1) or (bp^[j+1] shr 7);
  91. {$R+}
  92. end;
  93.  
  94. end.
  95.