home *** CD-ROM | disk | FTP | other *** search
/ Garbo / Garbo.cdr / mac / graphics / mactonxt.sit / bitpackunit.p / bitpackunit.p
Encoding:
Text File  |  1989-03-14  |  7.8 KB  |  297 lines  |  [TEXT/MPS ]
  1. unit bitpackunit;
  2. {
  3.     Copyright ⌐ 1989 Albert Lunde, Northwestern University
  4.     All Rights Reserved
  5. }
  6.  
  7. {pack and unpack streams of bits}
  8. interface
  9. uses memtypes,quickdraw,osintf,toolintf,packintf; 
  10.  
  11. procedure longtohex(ll:longint;var hex:str255);
  12.  
  13. procedure dumphex(ll:longint); {write longint as hex for debug}
  14.  
  15. procedure stripbits(source:ptr;
  16.                     source_bits_per_item:integer;
  17.                     source_bytesize:longint;
  18.                     dest:ptr;
  19.                     dest_bits_per_item:integer;
  20.                     dest_bytesize:longint;
  21.                     first_item:longint;
  22.                     last_item:longint;
  23.                     invert:boolean);
  24.                     
  25.  
  26. procedure bitstream_unpack(    source:ptr;{input bytes}
  27.                             source_item_count:longint;
  28.                             source_bits_per_item:integer;{24 or less}
  29.                             dest:ptr;{output bytes,words, or longwords}
  30.                             dest_max_bytes:longint;
  31.                             var dest_item_count:longint;
  32.                             dest_bytes_per_item:integer;{1,2,4}
  33.                             dest_low_bit_alignment:integer);
  34.  
  35. procedure bitstream_pack(    source:ptr;{input bytes}
  36.                             source_item_count:longint;
  37.                             source_bytes_per_item:integer;{1,2,4}
  38.                             source_low_bit_alignment:integer;
  39.                             dest:ptr;{output bytes,words, or longwords}
  40.                             dest_max_bytes:longint;
  41.                             dest_bits_per_item:integer;{24 or less}
  42.                             var dest_item_count:longint);
  43. implementation
  44.  
  45. procedure longtohex(ll:longint;var hex:str255);
  46. const mask=$0000000F;
  47. var i,dd:integer;
  48. begin
  49. hex:='';
  50. for i:=1 to 8 do
  51.    begin
  52.    dd:=integer(bitand(ll,mask));
  53.    hex:=concat(Copy('0123456789ABCDEF',dd+1,1),hex);
  54.    ll:=bitshift(ll,-4);
  55.    end;
  56. end;{longtohex}
  57.  
  58. procedure dumphex{(ll:longint)};
  59. var ss:str255;
  60. begin
  61. longtohex(ll,ss);
  62. write(ss,' ');
  63. end;{dumphex}
  64.  
  65. procedure stripbits(* (source:ptr;
  66.                     source_bits_per_item:integer;
  67.                     source_bytesize:longint;
  68.                     dest:ptr;
  69.                     dest_bits_per_item:integer;
  70.                     dest_bytesize:longint;
  71.                     first_item:longint;
  72.                     last_item:longint;
  73.                     invert:boolean) *);
  74.                     
  75. {truncate or pad a stream of bits}
  76. label 99;
  77. var sbit,dbit:longint;
  78.     sourcebyte:longint;
  79.     destbyte:longint;
  80.     soff,doff:integer;
  81.     i,j,di:longint;
  82.     minbits:integer;
  83.     bit:boolean;
  84. begin
  85. if source_bits_per_item<dest_bits_per_item then
  86.      minbits:=source_bits_per_item
  87.    else
  88.      minbits:=dest_bits_per_item;
  89. minbits:=minbits-1;
  90. di:=0;{destination item count}
  91. for i:=first_item-1 to last_item-1 do
  92.    begin
  93.      for j:=0 to minbits do
  94.            begin
  95.                sbit:=j+i*source_bits_per_item;
  96.                dbit:=j+di*dest_bits_per_item;
  97.                sourcebyte:=bsr(sbit,3);
  98.                destbyte:=bsr(dbit,3);
  99.                if sourcebyte<source_bytesize then
  100.                   begin
  101.                     bit:=bittst(source,sbit);
  102.                     if invert then bit:=not bit;
  103.                   end
  104.                else
  105.                   begin
  106.                     bit:=false;
  107.                   end;
  108.                 if destbyte<dest_bytesize then
  109.                   begin
  110.                     if bit then
  111.                       bitset(dest,dbit)
  112.                     else
  113.                       bitclr(dest,dbit);
  114.                   end
  115.                 else
  116.                   begin
  117.                     goto 99;
  118.                   end;
  119.            end;{bit copy loop}
  120.            
  121.         for j:=minbits+1 to dest_bits_per_item-1 do
  122.            begin
  123.            {clear unused bits in destination}
  124.                dbit:=j+di*dest_bits_per_item;
  125.                destbyte:=bsr(dbit,3);
  126.                 if destbyte<dest_bytesize then
  127.                   begin
  128.                       bitclr(dest,dbit);
  129.                   end
  130.                 else
  131.                   begin
  132.                     goto 99;
  133.                   end;
  134.            end;{bit fill loop}
  135.            
  136.    di:=di+1;{destination item count}
  137.    end;{item loop}
  138. 99:
  139. end;
  140.  
  141.  
  142. procedure bitstream_unpack(*(    source:ptr;{input bytes}
  143.                             source_item_count:longint;
  144.                             source_bits_per_item:integer;{24 or less}
  145.                             dest:ptr;{output bytes,words, or longwords}
  146.                             dest_max_bytes:longint;
  147.                             var dest_item_count:longint;
  148.                             dest_bytes_per_item:integer;{1,2,4}
  149.                             dest_low_bit_alignment:integer)*);
  150. {unpack a stream of bits into an array of bytes,words or longint}
  151. {use high to low left to right coodinates for bits and bytes
  152.  except for dest_low_bit_alignment which is an offset from the right}
  153. var item:longint;
  154.     startbit,endbit:longint;
  155.     startbyte,endbyte,bytecount:longint;
  156.     destbyte:longint;
  157.     endphase:integer;
  158.     work,destmask:longint;
  159.     sourcestrip,deststrip:longint;{address for pointer arithmetic}
  160.     wptr,outptr:ptr;
  161.     i:longint;
  162.     morephase:integer;
  163. begin
  164. destbyte:=0;
  165.  
  166. {strip address to allow pointer arithmetic}
  167. sourcestrip:=ord4(stripaddress(source));
  168. deststrip:=ord4(stripaddress(dest));
  169.  
  170. {make destination mask}
  171. destmask:=bsr($FFFFFFFF,32-source_bits_per_item);
  172. outptr:=pointer(ord(@work)+4-dest_bytes_per_item);{pointer to item to output}
  173. if source_bits_per_item>1 then
  174.     begin
  175.     {multi bit unpack loop}
  176.     for i:=1 to source_item_count do
  177.       begin
  178.         work:=0;
  179.      {0123456789012345678901234567890123456789 bit count
  180.       0123456701234567012345670123456701234567 bit from left in byte
  181.       7654321076543210765432107654321076543210 bit from right in byte
  182.       0000000011111111222222223333333344444444 byte count
  183.       111222333444555666777888999000111222333  item count (3 bits per item)
  184.       }
  185.         startbit:=source_bits_per_item*(i-1);
  186.         endbit:=(source_bits_per_item*i)-1;
  187.         startbyte:=bsr(startbit,3);
  188.                 { div 8 (round down to byte)}
  189.         endbyte:=bsr(endbit,3);
  190.                 {div 8 (round down to byte)}
  191.         endphase:=(bsl(endbyte,3)+7)-endbit;
  192.                 {amount needed to right justify to a byte}
  193.         bytecount:=endbyte-startbyte+1;
  194.         morephase:=bsl(4-bytecount,3);
  195.                 {amount needed to right justify in longint}
  196.      (*   writeln('startbit=',startbit);
  197.         writeln('endbit=',endbit);
  198.         writeln('startbyte=',startbyte);
  199.         writeln('endbyte=',endbyte);
  200.         writeln('bytecount=',bytecount);
  201.         writeln('phase=',endphase,' + ',morephase);*)
  202.         
  203.         wptr:=pointer(sourcestrip+startbyte);
  204.         blockmove(wptr,@work,bytecount);
  205.         (*dumphex(work);
  206.         writeln(work);*)
  207.         work:=bsl(band(bsr(work,endphase+morephase),destmask),dest_low_bit_alignment);
  208.         (*dumphex(work);
  209.         writeln(work);*)
  210.         if destbyte+dest_bytes_per_item<=dest_max_bytes then {??????}
  211.             begin
  212.                 dest_item_count:=dest_item_count+1;
  213.                 (*writeln('destbyte=',destbyte);*)
  214.                 wptr:=pointer(deststrip+destbyte);
  215.                 blockmove(outptr,wptr,dest_bytes_per_item);
  216.             end;
  217.         destbyte:=destbyte+dest_bytes_per_item;
  218.       end;{for}
  219.     end{multibit}
  220. else
  221.     begin
  222.     {single bit unpack loop}
  223.     for i:=1 to source_item_count do
  224.       begin
  225.         startbit:=(i-1);
  226.         if bittst(source,startbit) then work:=1 else work:=0;
  227.         work:=bsl(work,dest_low_bit_alignment);
  228.         {this is a clone of code above:}
  229.         if destbyte+dest_bytes_per_item<=dest_max_bytes then {??????}
  230.             begin
  231.                 dest_item_count:=dest_item_count+1;
  232.                 wptr:=pointer(deststrip+destbyte);
  233.                 blockmove(outptr,wptr,dest_bytes_per_item);
  234.             end;
  235.         destbyte:=destbyte+dest_bytes_per_item;
  236.  
  237.       end;{for}
  238.     end;{singlebit}
  239. end;{proc bitstream_unpack}
  240.  
  241. procedure bitstream_pack (*(    source:ptr;{input bytes}
  242.                             source_item_count:longint;
  243.                             source_bytes_per_item:integer;{1,2,4}
  244.                             source_low_bit_alignment:integer;
  245.                             dest:ptr;{output bytes,words, or longwords}
  246.                             dest_max_bytes:longint;
  247.                             dest_bits_per_item:integer;{24 or less}
  248.                             var dest_item_count:longint) *);
  249. {quick and dirty version based on the toolbox bit testing routines}
  250. label 99;
  251. var item:longint;
  252.     sourcebit,sb,db:longint;
  253.     startoffset,endoffset,source_bits_per_unit:integer;
  254.     destbyte:longint;
  255.     i:longint;
  256. begin
  257. dest_item_count:=0;
  258. {compute offsets within the source units(bytes,words,longwrds)
  259. for the block of bits to be copied}
  260.  
  261.  source_bits_per_unit:=8*source_bytes_per_item;
  262.  endoffset:=source_bits_per_unit-1-source_low_bit_alignment;
  263.  startoffset:=endoffset-dest_bits_per_item+1;
  264.  
  265. for i:=1 to source_item_count do
  266.   begin
  267.   (*writeln('item=',i);*)
  268.   sourcebit:=(i-1)*source_bits_per_unit;
  269.   db:=(i-1)*dest_bits_per_item;
  270.   for sb:=sourcebit+startoffset to sourcebit+endoffset do
  271.      begin
  272.      destbyte:=BSR(db,3);
  273.      (*writeln('sb=',sb);
  274.      writeln('db=',db);*)
  275.      if(db<=dest_max_bytes)then
  276.         begin
  277.             if bittst(source,sb) then
  278.                 begin
  279.                     bitset(dest,db);
  280.                 end
  281.              else
  282.                 begin
  283.                     bitclr(dest,db);
  284.                 end
  285.         end
  286.      else
  287.        begin
  288.         goto 99;
  289.        end;
  290.      db:=db+1;
  291.      end;
  292.      dest_item_count:=dest_item_count+1;
  293.   end;
  294. 99:{breakout}
  295. end;{proc bitstream_pack}
  296.  
  297. end.