home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / progs / extweave.icn < prev    next >
Text File  |  2000-07-29  |  4KB  |  146 lines
  1. ############################################################################
  2. #
  3. #    File:     extweave.icn
  4. #
  5. #    Subject:  Program to extract weaving specifications from weave file
  6. #
  7. #    Author:   Ralph E. Griswold
  8. #
  9. #    Date:     September 17, 1998
  10. #
  11. ############################################################################
  12. #
  13. #  This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  This program extracts the weaving specifications from a Macintosh
  18. #  Painter 5 weave file in MacBinary format.  (It might work on Painter 4
  19. #  weave files; this has not been tested.)
  20. #
  21. #  The file is read from standard input.
  22. #
  23. #  The output consists of seven lines for each weaving specification in the
  24. #  file:
  25. #
  26. #    wave name
  27. #    warp expression
  28. #    warp color expression
  29. #    weft expression
  30. #    weft color expression
  31. #    tie-up
  32. #    blank separator
  33. #
  34. #  The tie-up is a 64-character string of 1s and 0s in column order. That
  35. #  is, the first 8 character represent the first column of the tie-up. A
  36. #  1 indicates selection, 0, non-selection.
  37. #
  38. #  This program does not produce the colors for the letters in color
  39. #  expressions.  We know where they are located but haven't yet figured
  40. #  out how to match letters to colors.
  41. #
  42. #  See Advanced Weaving, a PDF file on the Painter 5 CD-ROM.
  43. #
  44. ############################################################################
  45.  
  46. $define Offset 401            # offset to the first expression
  47.  
  48. procedure main(args)
  49.    local hex, tieup, i, binary, expr, name, namechars, tartans_list
  50.  
  51.    namechars := &letters ++ &digits ++ ' -&'
  52.  
  53.    tartans_list := []
  54.  
  55.    binary := ""
  56.  
  57.    while binary ||:= reads(, 10000)        # read the whole file
  58.  
  59.    #  Get names.
  60.  
  61.    binary ? {
  62.       tab(find("FSWI") + 4)            # find names
  63.       while tab(upto(namechars)) do {        # not robust
  64.          name := tab(many(namechars))
  65.          if (*name > 3) | (name == "Op") then    # "heuristic"
  66.             put(tartans_list, name)
  67.          tab(upto(namechars)) | break
  68.          tab(many(namechars))
  69.          }
  70.       }
  71.  
  72.    binary ? {
  73.       move(400) | stop("delta move error")
  74.       hex := move(4400) | stop("short file")
  75.       write(get(tartans_list)) | stop("short name list")
  76.       hex ? {                # get the four expressions
  77.          every i := (0 to 3) do {
  78.             tab(i * 2 ^ 10 + 1)
  79.             expr := tab(upto('\x00')) | stop("no null character")
  80.             if *expr = 0 then stop("no expression")    # no expression
  81.             write(expr)
  82.             }
  83.          tieup := ""
  84.          tab(4101)                # now the tie-up
  85.          every 1 to 8 do {
  86.             tieup ||:= map(move(8), "\x0\x1", "01")
  87.             move(24)
  88.             }
  89.          write(decol(tieup))
  90.          write()
  91.          }
  92.       }
  93.  
  94.    binary ? {
  95.       while tab(find(".KWROYL")) do {
  96.          move(4908) | stop("delta move error")
  97.          hex := move(4400) | break
  98.          write(get(tartans_list)) | stop("short name list")
  99.          hex ? {                # get the four expressions
  100.             every i := (0 to 3) do {
  101.                tab(i * 2 ^ 10 + 1)
  102.                expr := tab(upto('\x00')) | stop("no null character")
  103.                if *expr = 0 then break break    # no expression
  104.                write(expr)
  105.                }
  106.             tieup := ""
  107.             tab(4101)                # now the tie-up
  108.             every 1 to 8 do {
  109.                tieup ||:= map(move(8), "\x0\x1", "01")
  110.                move(24)
  111.                }
  112.             write(decol(tieup))
  113.             write()
  114.             }
  115.          }
  116.       }    
  117.  
  118.    if *tartans_list > 0 then {
  119.       write("Unresolved tartans:")
  120.       write()
  121.       while write(get(tartans_list))
  122.       }
  123.  
  124. end
  125.  
  126. procedure decol(s)
  127.    local parts, j, form
  128.  
  129.    parts := list(8, "")
  130.  
  131.    s ? {
  132.       repeat {
  133.          every j := 1 to 8 do {
  134.             (parts[j] ||:= move(1)) | break break
  135.             }
  136.          }
  137.       }
  138.  
  139.    form := ""
  140.  
  141.    every form ||:= !parts
  142.  
  143.    return form
  144.  
  145. end
  146.