home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / contrib / treefox.lzh / trees.icn < prev    next >
Text File  |  1993-04-29  |  8KB  |  269 lines
  1. ## TREES.ICN
  2. global Lines, max, inter, inp, out, insitu, catlen, tabs,
  3. calctabs, tincr, toffset, tadj, leftm
  4. procedure main()
  5.   max := 8
  6.   calctabs := 0
  7.   tincr := 6       # C10=7.2 C16=4.32 C12=6
  8.   toffset := 1
  9.   leftm := 72
  10.   tadj := 4
  11.   out := open("TREES.OUT","w")
  12.   write("\n\nTREES - tree drawing utility")
  13.   write("(c) M. Jahn 1992")
  14.   write("\nPlease note:")
  15.   write("  - Input is expected from TREES.IN (ASCII)")
  16.   write("      (see sample in TREES.IN)")
  17.   write("  - Output goes to TREES.OUT")
  18.   write("\nSettings:")
  19.   writes("  Max Depth: (ENTER=8)  ")
  20.   max:=integer(read())
  21.   write("  Format:  (ENTER=terminals on baseline)")
  22.   writes("           (    1=terminals in situ  )  ")
  23.   insitu := read()
  24.   writes("  Calculate Tabstops: (ENTER=no) ")
  25.   if getch() ~== char(13) then {
  26.     write()
  27.     calctabs := 1
  28.     writes("    Increment Value         (ENTER=6): ")
  29.     tincr := numeric(read())
  30.     writes("    Left Margin at         (ENTER=72): ")
  31.     leftm := numeric(read())
  32.     writes("    Indent how many spaces  (ENTER=1): ")
  33.     toffset:=integer(read())
  34.     if toffset<1 then toffset := 1
  35.     writes("    Proportional Adjustment (ENTER=4): ")
  36.     tadj := numeric(read())
  37.   }
  38.   write()
  39.   if insitu=="" then insitu:=0 else insitu := 1
  40.   (inp := open("TREES.IN")) | stop("TREES.IN not found")
  41.   repeat {
  42.     (lst0 := makestree()) | stop("eof: TREES.IN.")
  43.     write(lst0)
  44.     (lst0||".") ? if not (tab(bal(".")) & pos(-1)) then
  45.       stop("brackets not balanced.")
  46.     showtree(lst0)
  47.   } #repeat loop
  48. end #main
  49.  
  50.  
  51. procedure makestree()
  52.   (zeile := getroot()) | fail
  53.   if find("(",zeile) then return zeile || ","
  54.   curr := trim(read(inp)[3:0])
  55.   curr := map(curr,".,","·√")
  56.   currlev := 1
  57.   while nxt := getnxt() do {
  58.     nxtlev := upto(~' ',nxt)
  59.     nxt := nxt[nxtlev:0]
  60.     nxtlev := integer(nxtlev / 2)
  61.     if nxtlev=currlev then zeile ||:= "," || curr else
  62.     if nxtlev > currlev then zeile ||:= ",(" || curr else
  63.       zeile ||:= "," || curr || repl(")", currlev-nxtlev)
  64.     #write("zeile=", zeile)
  65.     #if read()=="x" then stop()
  66.     curr := nxt
  67.     currlev := nxtlev
  68.   }
  69.   zeile ||:= "," || curr || repl(")", currlev-1)
  70.   #write("letzte zeile=", zeile)
  71.   return "*" || zeile || ","
  72. end #makestree
  73.  
  74. procedure getroot()
  75.   while x := trim(read(inp)) do {
  76.     if (x[1]=="#") | (x=="") then { write(out, x); next }
  77.     return x
  78.   }
  79. end
  80.  
  81. procedure getnxt()
  82.   (nxt := trim(read(inp))) | fail
  83.   if nxt=="" then fail
  84.   return map(nxt,".,","·√")
  85. end
  86.  
  87. procedure get_terms(tree)
  88. local st, x
  89.   st:=""
  90.   tree ? if tab(bal(',)')+1) then {
  91.     while x := tab(bal(',)')) do {
  92.       if x[1] ~== "(" then st ||:= x || "_"
  93.         else st ||:= get_terms(x[2:-1]||",")
  94.       move(1)
  95.     }
  96.   }
  97.   return st
  98. end
  99.  
  100.  
  101. procedure showtree(L)
  102.   Lines := []; inter := []
  103.   every 1 to max do {
  104.     put(Lines,""); put(inter,"")
  105.   }
  106.   handlelist(L,1)
  107.   postproc()
  108.   show(L)
  109. end
  110.  
  111. procedure handlelist(tree,n)
  112.   tree ? if move(1) then {
  113.     (cat := tab(upto(','))) | {write("empty list."); read(); fail}
  114.     if n<=3 then catlen := 4
  115.     if *cat<catlen then cat:=center(cat,catlen,"ⁿ") else catlen:=*cat
  116.     repeat {
  117.       move(1)
  118.       (x:=tab(bal(',)'))) | break
  119.       if (n>=(max-1)) & (x[1]=="(") then x:=get_terms(x[2:-1]||",")
  120.       if x[1]~=="(" then {
  121.         x:=trim(x,"_")
  122.         if *x<catlen then x:=center(x,catlen,"ⁿ")
  123.  
  124.         if insitu=1 then xline:=n+2 else xline := max
  125.         if xline> max then xline:=max
  126.  
  127.         if *Lines[max]>*Lines[n+1] then {
  128.           Lines[n+1]:=left(Lines[n+1], *Lines[max], ".")
  129.           inter[n+1]:=left(inter[n+1], *Lines[max], ".")
  130.         }
  131.         a := "." || center("│",*x,"ⁿ") || "."
  132.         Lines[n+1] ||:= a
  133.         inter[n+1] ||:= a
  134.         if insitu=0 then every i := n+2 to max-1 do {
  135.           Lines[i] := left(Lines[i], *Lines[n+1]- (*x+2)) || a
  136.           inter[i]:= left(inter[i], *Lines[n+1]- (*x+2),".") || a
  137.         }  else {
  138.            every i := n+2 to max do {
  139.              Lines[i]:=left(Lines[i], *Lines[n+1],".")
  140.              inter[i]:=left(inter[i], *Lines[n+1],".")
  141.            }
  142.         }
  143.         Lines[xline] := left(Lines[xline], *Lines[n+1]- (*x+2)) || "." || x || "."
  144.         if insitu=0 then inter[xline] := left(".", *Lines[xline])
  145.         #show("item")
  146.       } else handlelist(x, n+1)
  147.     }
  148.     Lines[n+1] ? if move(*Lines[n]) then {
  149.       x:=tab(upto(~'.'))
  150.       Lines[n]||:= x; inter[n]||:=x
  151.     }
  152.     len:=*Lines[n]
  153.     x:= center("-", *trim(Lines[n+1],".")-len,"-")
  154.     Lines[n+1][len+1:0] ? while tab(a:=upto(~'.')) do {
  155.         if x[a]==("-") then {
  156.           tab(b:=many(~'.'))
  157.           b-:=1
  158.           mid :=a+integer((b-a)/2)
  159.           x[mid]:="!"
  160.         } else tab(b:=many(~'.'))
  161.       }
  162.     x:="." || x || "."
  163.     while a:=find(".-", x) do x[a+1]:="."
  164.     while a:=find("-.", x) do x[a]:="."
  165.     x:= x[2:-1]
  166.     inter[n]||:=x
  167.     (L:=find("!", x)) | (L:=10)
  168.     (R:=find("!.", x||".")) | (R:=10)
  169.     vor := left(".", L-1,".")
  170.     Insert := center(cat,R-L+1,".")
  171.     if (R-L)>=*cat then {  # range of items
  172.       a:=upto(~'.',Insert)-1
  173.       mid := len  + *vor + a+ integer((*cat+1)/2)
  174.       Lines[n] ||:= vor || Insert
  175.       Lines[n] := left(Lines[n], *inter[n],".")
  176.       if inter[n][mid]=="-" then inter[n][mid]:="t"
  177.         else inter[n][mid]:="+"
  178.       #show("RL-item")
  179.     } else {  # single item
  180.         if integer(*cat/2*2)=*cat then cat:="."||cat
  181.         #show("embedded list")
  182.         if inter[n][-1]~=="." then {
  183.           Lines[n]:=left(Lines[n],*inter[n]-(integer(*cat/2)+1),".")
  184.           Lines[n] ||:= cat
  185.         } else {
  186.             a:=*trim(Lines[n+1],".")-len
  187.             Lines[n] ||:= center(cat, a,".")
  188.             #show("single item")
  189.         }
  190.     } # repeat
  191.   } #if
  192. end
  193.  
  194.  
  195.  
  196. procedure postproc()
  197.   tabs := set([])
  198.   rep1:=[".!.",".!", "-!.", "-!-", "t!", "!t",".+."]
  199.   rep2:=[".i.",".L", "-R.", "-T-", "tT", "Tt",".!."]
  200.   every i:= 2 to max do {
  201.     if calctabs=1 then
  202.     inter[i-1] ? while tab(upto('i!LRTt+')) do {
  203.       insert(tabs, &pos+toffset-1)
  204.       move(1)
  205.     }
  206.     inter[i-1] := replace(inter[i-1]||".",rep1,rep2)
  207.     inter[i-1] := map(inter[i-1],"i!LRTt+-.","││┌┐┬┴┼─ ")
  208.   }
  209.   if calctabs=1 then {
  210.     tabs := sort(tabs)
  211.     writes(out,"Branches in columns: ")
  212.     every writes(out,!tabs, " ")
  213.     write(out,"\nTabstops from Margin offset: ", toffset,
  214.       "; by Increments: ", tincr)
  215.     write(out,"Set center Tabs at: ")
  216.     every i := 1 to *tabs do {
  217.       #writes(out, left((tabs[i]-1)*4.32 + 74.5, 5)," ")
  218.       writes(out, left((tabs[i]-1)*tincr + leftm + tadj, 5)," ")
  219.     }
  220.     write(out)
  221.   }
  222. end #postproc
  223.  
  224.  
  225. procedure replace(subject, rep1, rep2)
  226.   every i:= 1 to *rep1 do
  227.   { search := rep1[i]
  228.     repeat
  229.     { subject ? if pre:=tab(find(search)) then
  230.       {  =(search)
  231.          subject := pre || rep2[i] || tab(0)
  232.       }
  233.       else break
  234.     }
  235.   }
  236.   return subject
  237. end
  238.  
  239. procedure show(L)
  240.   write()
  241.   preindent := repl(" ",toffset-1)
  242.   every i:=1 to max do {
  243.     if Lines[i]=="" then break
  244.     st:= preindent||trim(map(Lines[i],".ⁿ·√","  .,"))
  245.     write(st, out, st)
  246.     if i=max then break
  247.     st:=preindent||trim(map(inter[i],"ⁿ.","  "))
  248.     if calctabs=1 then {
  249.       st1 := " "
  250.       every j := 1 to *tabs do {
  251.         x := tabs[j]
  252.         if any(~' ─',st[x]) then {
  253.           st1 := left(st1,x-1)
  254.           #if st1[-1]==" " then st1||:= left((x-1)*4.32 + 74.5, 3)
  255.           #st1 ||:= left((x-1)*4.32 + 74.5, 3)
  256.           st1 ||:= left((x-1)*tincr + leftm + tadj, 3)
  257.         }
  258.       }
  259.       write(st1, out,st1)
  260.     }
  261.     write(st, out, st)
  262.   }
  263.   write("ENTER=continue  q=quit ")
  264.   ch := getch()
  265.   if ch=="q" then stop()
  266. end
  267.  
  268.  
  269.