home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OL.LZH / PROCS.LZH / OUTBITS.ICN < prev    next >
Text File  |  1991-09-05  |  3KB  |  94 lines
  1. ############################################################################
  2. #
  3. #    Name:     outbits.icn
  4. #
  5. #    Title:     output variable-length characters in byte-size chunks
  6. #
  7. #    Author:     Richard L. Goerwitz
  8. #
  9. #    Version: 1.2
  10. #
  11. #    Date:     June 1, 1991
  12. #
  13. ############################################################################
  14. #
  15. #  In any number of instances (e.g. when outputting variable-length
  16. #  characters or fixed-length encoded strings), the programmer must
  17. #  fit variable and/or non-byte-sized blocks into standard 8-bit
  18. #  bytes.  Outbits() performs this task.
  19. #
  20. #  Pass to outbits(i, len) an integer i, and a length parameter (len),
  21. #  and outbits will suspend byte-sized chunks of i converted to
  22. #  characters (most significant bits first) until there is not enough
  23. #  left of i to fill up an 8-bit character.  The remaining portion is
  24. #  stored in a buffer until outbits() is called again, at which point
  25. #  the buffer is combined with the new i and then output in the same
  26. #  manner as before.  The buffer is flushed by calling outbits() with
  27. #  no i argument.
  28. #
  29. #  A trivial example of how outbits() might be used:
  30. #
  31. #      outtext := open("some.file.name","w")
  32. #      l := [1,2,3,4]
  33. #      every writes(outtext, outbits(!l,3))
  34. #      writes(outtext, outbits(&null,3))           # flush buffer
  35. #
  36. #  List l may be reconstructed with inbits() (see inbits.icn):
  37. #
  38. #      intext := open("some.file.name")
  39. #      l := []
  40. #      while put(l, inbits(intext, 3))
  41. #
  42. #  Note that outbits() is a generator, while inbits() is not.
  43. #
  44. ############################################################################
  45. #
  46. #  See also: inbits.icn
  47. #
  48. ############################################################################
  49.  
  50. procedure outbits(i, len)
  51.  
  52.     local old_part, new_part, window, old_byte_mask
  53.     static old_i, old_len, byte_length, byte_mask
  54.     initial {
  55.     old_i := old_len := 0
  56.     byte_length := 8
  57.     byte_mask := (2^byte_length)-1
  58.     }
  59.  
  60.     old_byte_mask := (0 < 2^old_len - 1) | 0
  61.     window := byte_length - old_len
  62.     old_part := ishift(iand(old_i, old_byte_mask), window)
  63.  
  64.     # If we have a no-arg invocation, then flush buffer (old_i).
  65.     if /i then {
  66.     old_i := old_len := 0
  67.     return char(old_part)
  68.     } else {
  69.     new_part := ishift(i, window-len)
  70.     len -:= (len >= window) | {
  71.         old_len +:= len
  72.         old_i := ior(ishift(old_part, len-window), i)
  73.         fail
  74.     }
  75. #    For debugging purposes.
  76. #    write("old_byte_mask = ", old_byte_mask)
  77. #    write("window = ", image(window))
  78. #    write("old_part = ", image(old_part))
  79. #    write("new_part = ", image(new_part))
  80. #    write("outputting ", image(ior(old_part, new_part)))
  81.     suspend char(ior(old_part, new_part))
  82.     }
  83.  
  84.     until len < byte_length do {
  85.     suspend char(iand(ishift(i, byte_length-len), byte_mask))
  86.     len -:= byte_length
  87.     }
  88.  
  89.     old_len := len
  90.     old_i := i
  91.     fail
  92.  
  93. end
  94.