home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / BIPL.ZIP / PROCS.ZIP / COLLATE.ICN < prev    next >
Encoding:
Text File  |  1992-09-28  |  2.4 KB  |  75 lines
  1. ############################################################################
  2. #
  3. #    File:     collate.icn
  4. #
  5. #    Subject:  Procedures to collate and decollate strings
  6. #
  7. #    Author:   Ralph E. Griswold
  8. #
  9. #    Date:     June 10, 1988
  10. #
  11. ###########################################################################
  12. #  
  13. #  These procedures collate (interleave) respective characters of
  14. #  two strings and decollate such strings by selecting every other
  15. #  character of a string.  produce a string consisting of inter-
  16. #  leaved characters of s1 and s2.
  17. #  
  18. #       collate(s1,s2) collate the characters of s1 and s2.  For
  19. #                      example,
  20. #
  21. #                           collate("abc","def")
  22. #
  23. #                      produces "adbecf".
  24. #  
  25. #       decollate(s,i) produce a string consisting of every other
  26. #                      character of s. If i is odd, the odd-numbered
  27. #                      characters are selected, while if i is even,
  28. #                      the even-numbered characters are selected.
  29. #  
  30. ############################################################################
  31.  
  32. procedure collate(s1,s2)
  33.    local length, ltemp, rtemp
  34.    static llabels, rlabels, clabels, blabels, half
  35.    initial {
  36.       llabels := "ab"
  37.       rlabels := "cd"
  38.       blabels := llabels || rlabels
  39.       clabels := "acbd"
  40.       half := 2
  41.       ltemp := left(&cset,*&cset / 2)
  42.       rtemp := right(&cset,*&cset / 2)
  43.       clabels := collate(ltemp,rtemp)
  44.       llabels := ltemp
  45.       rlabels := rtemp
  46.       blabels := string(&cset)
  47.       half := *llabels
  48.       }
  49.    length := *s1
  50.    if length <= half then
  51.       return map(left(clabels,2 * length),left(llabels,length) ||
  52.          left(rlabels,length),s1 || s2)
  53.    else return map(clabels,blabels,left(s1,half) || left(s2,half)) ||
  54.       collate(right(s1,length - half),right(s2,length - half))
  55. end
  56.  
  57. #  decollate s according to even or odd i
  58. #
  59. procedure decollate(s,i)
  60.    static dsize, image, object
  61.    local ssize
  62.    initial {
  63.       image := collate(left(&cset,*&cset / 2),left(&cset,*&cset / 2))
  64.       object := left(&cset,*&cset / 2)
  65.       dsize := *image
  66.       }
  67.    i %:= 2
  68.    ssize := *s
  69.    if ssize + i <= dsize then
  70.       return map(object[1+:(ssize + i) / 2],image[(i + 1)+:ssize],s)
  71.    else return map(object[1+:(dsize - 2) / 2],image[(i + 1)+:dsize - 2],
  72.       s[1+:(dsize - 2)]) || decollate(s[dsize - 1:0],i)
  73. end
  74.  
  75.