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