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 / lsysmap.icn < prev    next >
Text File  |  2000-07-29  |  2KB  |  86 lines
  1. ############################################################################
  2. #
  3. #    File:     lsysmap.icn
  4. #
  5. #    Subject:  Program to map L-system symbols
  6. #
  7. #    Author:   Ralph E. Griswold
  8. #
  9. #    Date:     June 18, 1998
  10. #
  11. ############################################################################
  12. #
  13. #  This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  This program maps the symbols in L-Systems.
  18. #
  19. #  The following options are supported:
  20. #
  21. #    -i s    input symbols for mapping; default &ucase
  22. #    -o s    output symbols for mapping; default &ucase
  23. #    -a    put symbols for axiom production in alphabetical
  24. #          order (ignores -i and -o)
  25. #    
  26. #  symbol strings are given on the command line, as in
  27. #
  28. #    lsysmap -i ABCD -o DCBA <exam.lys
  29. #
  30. #  There is little error checking.  It's possible to produce an invalid
  31. #  L-system by creating duplicate nonterminals or changing metacharacters.
  32. #
  33. #  The program handles two-level grammars using the first axiom symbol.
  34. #
  35. ############################################################################
  36. #
  37. #  Links:  options, strings
  38. #
  39. ############################################################################
  40.  
  41. link options
  42. link strings
  43.  
  44. procedure main(args)
  45.    local isyms, osyms, line, defs, axiom, i, opts, symbols, done
  46.  
  47.    opts := options(args, "i:s:a")
  48.  
  49.    if /opts["a"] then {
  50.       isyms := \opts["i"] | &ucase
  51.       osyms := \opts["o"] | &ucase
  52.       if *isyms ~= *osyms then
  53.          stop("*** input and output strings not of equal length")
  54.       }
  55.  
  56.    defs := []
  57.    symbols := ''
  58.  
  59.    while line := read() do {
  60.       put(defs, line)
  61.       line ? {
  62.          if ="axiom:" then {
  63.             if not(/axiom := move(1)) then    # not first axiom
  64.             done := 1            # turn off gathering nontrminals 
  65.             }
  66.          else if =\axiom & ="->" & /isyms then isyms := tab(0)
  67.          if /done & find("->") then symbols ++:= move(1)
  68.          }
  69.       }
  70.  
  71.    isyms := deletec(isyms, &cset -- symbols)
  72.    isyms := ochars(isyms)
  73.    osyms := csort(isyms)
  74.  
  75.    every i := 1 to *defs do {
  76.       defs[i] ?:= {
  77.          (="axiom:" || map(move(1), isyms, osyms)) |
  78.          (find("->") & map(tab(0), isyms, osyms)) |
  79.          tab(0)
  80.          }
  81.       }
  82.          
  83.    every write(!defs)
  84.  
  85. end
  86.