home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / gnu / gawk213b / chem.awk < prev    next >
Encoding:
AWK Script  |  1993-07-29  |  11.9 KB  |  492 lines
  1. BEGIN {
  2.     macros = "./chem.macros"    # CHANGE ME!!!!!
  3.  
  4.     pi = 3.141592654
  5.     deg = 57.29578
  6.     setparams(1.0)
  7.     set(dc, "up 0 right 90 down 180 left 270 ne 45 se 135 sw 225 nw 315")
  8.     set(dc, "0 n 30 ne 45 ne 60 ne 90 e 120 se 135 se 150 se 180 s")
  9.     set(dc, "300 nw 315 nw 330 nw 270 w 210 sw 225 sw 240 sw")
  10. }
  11. function init() {
  12.     printf ".PS\n"
  13.     if (firsttime++ == 0) {
  14.         printf "copy \"%s\"\n", macros
  15.         printf "\ttextht = %.6g; textwid = .1; cwid = %.6g\n", textht, cwid
  16.         printf "\tlineht = %.6g; linewid = %.6g\n", lineht, linewid
  17.     }
  18.     printf "Last: 0,0\n"
  19.     RING = "R"; MOL = "M"; BOND = "B"; OTHER = "O"    # manifests
  20.     last = OTHER
  21.     dir = 90
  22. }
  23. function setparams(scale) {
  24.     lineht = scale * 0.2
  25.     linewid = scale * 0.2
  26.     textht = scale * 0.16
  27.     db = scale * 0.2        # bond length
  28.     cwid = scale * 0.12        # character width
  29.     cr = scale * 0.08        # rad of invis circles at ring vertices
  30.     crh = scale * 0.16        # ht of invis ellipse at ring vertices
  31.     crw = scale * 0.12        # wid    
  32.     dav = scale * 0.015        # vertical shift up for atoms in atom macro
  33.     dew = scale * 0.02        # east-west shift for left of/right of
  34.     ringside = scale * 0.3        # side of all rings
  35.     dbrack = scale * 0.1        # length of bottom of bracket
  36. }
  37.  
  38.     { lineno++ }
  39.  
  40. /^(\.cstart)|(begin chem)/    { init(); inchem = 1; next }
  41. /^(\.cend)|(end)/        { inchem = 0; print ".PE"; next }
  42.  
  43. /^\./        { print; next }        # troff
  44.  
  45. inchem == 0    { print; next }        # everything else
  46.  
  47. $1 == "pic"    { shiftfields(1); print; next }    # pic pass-thru
  48. $1 ~ /^#/    { next }    # comment
  49.  
  50. $1 == "textht"    { textht = $NF; next }
  51. $1 == "cwid"    { cwid = $NF; next }
  52. $1 == "db"    { db = $NF; next }
  53. $1 == "size"    { if ($NF <= 4) size = $NF; else size = $NF/10
  54.           setparams(size); next }
  55.  
  56.     { print "\n#", $0 }    # debugging, etc.
  57.     { lastname = "" }
  58.  
  59. $1 ~ /^[A-Z].*:$/ {    # label;  falls thru after shifting left
  60.     lastname = substr($1, 1, length($1)-1)
  61.     print $1
  62.     shiftfields(1)
  63. }
  64.  
  65. $1 ~ /^\"/    { print "Last: ", $0; last = OTHER; next }
  66.  
  67. $1 ~ /bond/    { bond($1); next }
  68. $1 ~ /^(double|triple|front|back)$/ && $2 == "bond" {
  69.            $1 = $1 $2; shiftfields(2); bond($1); next }
  70.  
  71. $1 == "aromatic" { temp = $1; $1 = $2; $2 = temp }
  72. $1 ~ /ring|benz/ { ring($1); next }
  73.  
  74. $1 == "methyl"    { $1 = "CH3" }    # left here as an example
  75.  
  76. $1 ~ /^[A-Z]/    { molecule(); next }
  77.  
  78. $1 == "left"    { left[++stack] = fields(2, NF); printf("Last: [\n"); next }
  79.  
  80. $1 == "right"    { bracket(); stack--; next }
  81.  
  82. $1 == "label"    { label(); next }
  83.  
  84. /./    { print "Last: ", $0; last = OTHER }    
  85.  
  86. END    { if (firsttime == 0) error("did you forget .cstart and .cend?")
  87.       if (inchem) printf ".PE\n"
  88. }
  89.  
  90. function bond(type,    i, goes, from) {
  91.     goes = ""
  92.     for (i = 2; i <= NF; i++)
  93.         if ($i == ";") {
  94.             goes = $(i+1)
  95.             NF = i - 1
  96.             break
  97.         }
  98.     leng = db
  99.     from = ""
  100.     for (cf = 2; cf <= NF; ) {
  101.         if ($cf ~ /(\+|-)?[0-9]+|up|down|right|left|ne|se|nw|sw/)
  102.             dir = cvtdir(dir)
  103.         else if ($cf ~ /^leng/) {
  104.             leng = $(cf+1)
  105.             cf += 2
  106.         } else if ($cf == "to") {
  107.             leng = 0
  108.             from = fields(cf, NF)
  109.             break
  110.         } else if ($cf == "from") {
  111.             from = dofrom()
  112.             break
  113.         } else if ($cf ~ /^#/) {
  114.             cf = NF+1
  115.             break;
  116.         } else {
  117.             from = fields(cf, NF)
  118.             break
  119.         }
  120.     }
  121.     if (from ~ /( to )|^to/)    # said "from ... to ...", so zap length
  122.         leng = 0
  123.     else if (from == "")    # no from given at all
  124.         from = "from Last." leave(last, dir) " " fields(cf, NF)
  125.     printf "Last: %s(%.6g, %.6g, %s)\n", type, leng, dir, from
  126.     last = BOND
  127.     if (lastname != "")
  128.         labsave(lastname, last, dir)
  129.     if (goes) {
  130.         $0 = goes
  131.         molecule()
  132.     }
  133. }
  134.  
  135. function dofrom(    n, s) {
  136.     cf++    # skip "from"
  137.     n = $cf
  138.     if (n in labtype)    # "from Thing" => "from Thing.V.s"
  139.         return "from " n "." leave(labtype[n], dir)
  140.     if (n ~ /^\.[A-Z]/)    # "from .V" => "from Last.V.s"
  141.         return "from Last" n "." corner(dir)
  142.     if (n ~ /^[A-Z][^.]*\.[A-Z][^.]*$/)    # "from X.V" => "from X.V.s"
  143.         return "from " n "." corner(dir)
  144.     return fields(cf-1, NF)
  145. }
  146.  
  147. function bracket(    t) {
  148.     printf("]\n")
  149.     if ($2 == ")")
  150.         t = "spline"
  151.     else
  152.         t = "line"
  153.     printf("%s from last [].sw+(%.6g,0) to last [].sw to last [].nw to last [].nw+(%.6g,0)\n",
  154.         t, dbrack, dbrack)
  155.     printf("%s from last [].se-(%.6g,0) to last [].se to last [].ne to last [].ne-(%.6g,0)\n",
  156.         t, dbrack, dbrack)
  157.     if ($3 == "sub")
  158.         printf("\" %s\" ljust at last [].se\n", fields(4,NF))
  159. }
  160.  
  161. function molecule(    n, type) {
  162.     n = $1
  163.     if (n == "BP") {
  164.         $1 = "\"\" ht 0 wid 0"
  165.         type = OTHER
  166.     } else {
  167.         $1 = atom(n)
  168.         type = MOL
  169.     }
  170.     gsub(/[^A-Za-z0-9]/, "", n)    # for stuff like C(OH3): zap non-alnum
  171.     if ($2 == "")
  172.         printf "Last: %s: %s with .%s at Last.%s\n", \
  173.             n, $0, leave(type,dir+180), leave(last,dir)
  174.     else if ($2 == "below")
  175.         printf("Last: %s: %s with .n at %s.s\n", n, $1, $3)
  176.     else if ($2 == "above")
  177.         printf("Last: %s: %s with .s at %s.n\n", n, $1, $3)
  178.     else if ($2 == "left" && $3 == "of")
  179.         printf("Last: %s: %s with .e at %s.w+(%.6g,0)\n", n, $1, $4, dew)
  180.     else if ($2 == "right" && $3 == "of")
  181.         printf("Last: %s: %s with .w at %s.e-(%.6g,0)\n", n, $1, $4, dew)
  182.     else
  183.         printf "Last: %s: %s\n", n, $0
  184.     last = type
  185.     if (lastname != "")
  186.         labsave(lastname, last, dir)
  187.     labsave(n, last, dir)
  188. }
  189.  
  190. function label(    i, v) {
  191.     if (substr(labtype[$2], 1, 1) != RING)
  192.         error(sprintf("%s is not a ring", $2))
  193.     else {
  194.         v = substr(labtype[$2], 2, 1)
  195.         for (i = 1; i <= v; i++)
  196.             printf("\"\\s-3%d\\s0\" at 0.%d<%s.C,%s.V%d>\n", i, v+2, $2, $2, i)
  197.     }
  198. }
  199.  
  200. function ring(type,    typeint, pt, verts, i) {
  201.     pt = 0    # points up by default
  202.     if (type ~ /[1-8]$/)
  203.         verts = substr(type, length(type), 1)
  204.     else if (type ~ /flat/)
  205.         verts = 5
  206.     else
  207.         verts = 6
  208.     fused = other = ""
  209.     for (i = 1; i <= verts; i++)
  210.         put[i] = dbl[i] = ""
  211.     nput = aromatic = withat = 0
  212.     for (cf = 2; cf <= NF; ) {
  213.         if ($cf == "pointing")
  214.             pt = cvtdir(0)
  215.         else if ($cf == "double" || $cf == "triple")
  216.             dblring(verts)
  217.         else if ($cf ~ /arom/) {
  218.             aromatic++
  219.             cf++    # handled later
  220.         } else if ($cf == "put") {
  221.             putring(verts)
  222.             nput++
  223.         } else if ($cf ~ /^#/) {
  224.             cf = NF+1
  225.             break;
  226.         } else {
  227.             if ($cf == "with" || $cf == "at")
  228.                 withat = 1
  229.             other = other " " $cf
  230.             cf++
  231.         }
  232.     }
  233.     typeint = RING verts pt        # RING | verts | dir
  234.     if (withat == 0)
  235.         fused = joinring(typeint, dir, last)
  236.     printf "Last: [\n"
  237.     makering(type, pt, verts)
  238.     printf "] %s %s\n", fused, other
  239.     last = typeint
  240.     if (lastname != "")
  241.         labsave(lastname, last, dir)
  242. }
  243.  
  244. function makering(type, pt, v,       i, a, r) {
  245.     if (type ~ /flat/)
  246.         v = 6
  247.     # vertices
  248.     r = ringside / (2 * sin(pi/v))
  249.     printf "\tC: 0,0\n"
  250.     for (i = 0; i <= v+1; i++) {
  251.         a = ((i-1) / v * 360 + pt) / deg
  252.         printf "\tV%d: (%.6g,%.6g)\n", i, r * sin(a), r * cos(a)
  253.     }
  254.     if (type ~ /flat/) {
  255.         printf "\tV4: V5; V5: V6\n"
  256.         v = 5
  257.     }
  258.     # sides
  259.     if (nput > 0) {    # hetero ...
  260.         for (i = 1; i <= v; i++) {
  261.             c1 = c2 = 0
  262.             if (put[i] != "") {
  263.                 printf("\tV%d: ellipse invis ht %.6g wid %.6g at V%d\n",
  264.                     i, crh, crw, i)
  265.                 printf("\t%s at V%d\n", put[i], i)
  266.                 c1 = cr
  267.             }
  268.             j = i+1
  269.             if (j > v)
  270.                 j = 1
  271.             if (put[j] != "")
  272.                 c2 = cr
  273.             printf "\tline from V%d to V%d chop %.6g chop %.6g\n", i, j, c1, c2
  274.             if (dbl[i] != "") {    # should check i<j
  275.                 if (type ~ /flat/ && i == 3) {
  276.                     rat = 0.75; fix = 5
  277.                 } else {
  278.                     rat = 0.85; fix = 1.5
  279.                 }
  280.                 if (put[i] == "")
  281.                     c1 = 0
  282.                 else
  283.                     c1 = cr/fix
  284.                 if (put[j] == "")
  285.                     c2 = 0
  286.                 else
  287.                     c2 = cr/fix
  288.                 printf "\tline from %.6g<C,V%d> to %.6g<C,V%d> chop %.6g chop %.6g\n",
  289.                     rat, i, rat, j, c1, c2
  290.                 if (dbl[i] == "triple")
  291.                     printf "\tline from %.6g<C,V%d> to %.6g<C,V%d> chop %.6g chop %.6g\n",
  292.                         2-rat, i, 2-rat, j, c1, c2
  293.             }
  294.         }
  295.     } else {    # regular
  296.         for (i = 1; i <= v; i++) {
  297.             j = i+1
  298.             if (j > v)
  299.                 j = 1
  300.             printf "\tline from V%d to V%d\n", i, j
  301.             if (dbl[i] != "") {    # should check i<j
  302.                 if (type ~ /flat/ && i == 3) {
  303.                     rat = 0.75
  304.                 } else
  305.                     rat = 0.85
  306.                 printf "\tline from %.6g<C,V%d> to %.6g<C,V%d>\n",
  307.                     rat, i, rat, j
  308.                 if (dbl[i] == "triple")
  309.                     printf "\tline from %.6g<C,V%d> to %.6g<C,V%d>\n",
  310.                         2-rat, i, 2-rat, j
  311.             }
  312.         }
  313.     }
  314.     # punt on triple temporarily
  315.     # circle
  316.     if (type ~ /benz/ || aromatic > 0) {
  317.         if (type ~ /flat/)
  318.             r *= .4
  319.         else
  320.             r *= .5
  321.         printf "\tcircle rad %.6g at 0,0\n", r
  322.     }
  323. }
  324.  
  325. function putring(v) {    # collect "put Mol at n"
  326.     cf++
  327.     mol = $(cf++)
  328.     if ($cf == "at")
  329.         cf++
  330.     if ($cf >= 1 && $cf <= v) {
  331.         m = mol
  332.         gsub(/[^A-Za-z0-9]/, "", m)
  333.         put[$cf] = m ":" atom(mol)
  334.     }
  335.     cf++
  336. }
  337.  
  338. function joinring(type, dir, last) {    # join a ring to something
  339.     if (substr(last, 1, 1) == RING) {    # ring to ring
  340.         if (substr(type, 3) == substr(last, 3))    # fails if not 6-sided
  341.             return "with .V6 at Last.V2"
  342.     }
  343.     # if all else fails
  344.     return sprintf("with .%s at Last.%s", \
  345.         leave(type,dir+180), leave(last,dir))
  346. }
  347.  
  348. function leave(last, d,        c, c1) {    # return vertex of last in dir d
  349.     if (last == BOND)
  350.         return "end"
  351.     d = reduce(d)
  352.     if (substr(last, 1, 1) == RING)
  353.         return ringleave(last, d)
  354.     if (last == MOL) {
  355.         if (d == 0 || d == 180)
  356.             c = "C"
  357.         else if (d > 0 && d < 180)
  358.             c = "R"
  359.         else
  360.             c = "L"
  361.         if (d in dc)
  362.             c1 = dc[d]
  363.         else 
  364.             c1 = corner(d)
  365.         return sprintf("%s.%s", c, c1)
  366.     }
  367.     if (last == OTHER)
  368.         return corner(d)
  369.     return "c"
  370. }
  371.  
  372. function ringleave(last, d,    rd, verts) {    # return vertex of ring in dir d
  373.     verts = substr(last, 2, 1)
  374.     rd = substr(last, 3)
  375.     return sprintf("V%d.%s", int(reduce(d-rd)/(360/verts)) + 1, corner(d))
  376. }
  377.  
  378. function corner(dir) {
  379.     return dc[reduce(45 * int((dir+22.5)/45))]
  380. }    
  381.  
  382. function labsave(name, type, dir) {
  383.     labtype[name] = type
  384.     labdir[name] = dir
  385. }
  386.  
  387. function dblring(v,    d, v1, v2) {    # should canonicalize to i,i+1 mod v
  388.     d = $cf
  389.     for (cf++; $cf ~ /^[1-9]/; cf++) {
  390.         v1 = substr($cf,1,1)
  391.         v2 = substr($cf,3,1)
  392.         if (v2 == v1+1 || v1 == v && v2 == 1)    # e.g., 2,3 or 5,1
  393.             dbl[v1] = d
  394.         else if (v1 == v2+1 || v2 == v && v1 == 1)    # e.g., 3,2 or 1,5
  395.             dbl[v2] = d
  396.         else
  397.             error(sprintf("weird %s bond in\n\t%s", d, $0))
  398.     }
  399. }
  400.  
  401. function cvtdir(d) {    # maps "[pointing] somewhere" to degrees
  402.     if ($cf == "pointing")
  403.         cf++
  404.     if ($cf ~ /^[+\-]?[0-9]+/)
  405.         return reduce($(cf++))
  406.     else if ($cf ~ /left|right|up|down|ne|nw|se|sw/)
  407.         return reduce(dc[$(cf++)])
  408.     else {
  409.         cf++
  410.         return d
  411.     }
  412. }
  413.  
  414. function reduce(d) {    # reduces d to 0 <= d < 360
  415.     while (d >= 360)
  416.         d -= 360
  417.     while (d < 0)
  418.         d += 360
  419.     return d
  420. }
  421.  
  422. function atom(s,    c, i, n, nsub, cloc, nsubc) { # convert CH3 to atom(...)
  423.     if (s == "\"\"")
  424.         return s
  425.     n = length(s)
  426.     nsub = nsubc = 0
  427.     cloc = index(s, "C")
  428.     if (cloc == 0)
  429.         cloc = 1
  430.     for (i = 1; i <= n; i++)
  431.         if (substr(s, i, 1) !~ /[A-Z]/) {
  432.             nsub++
  433.             if (i < cloc)
  434.                 nsubc++
  435.         }
  436.     gsub(/([0-9]+\.[0-9]+)|([0-9]+)/, "\\s-3\\d&\\u\\s+3", s)
  437.     if (s ~ /([^0-9]\.)|(\.[^0-9])/)    # centered dot
  438.         gsub(/\./, "\\v#-.3m#.\\v#.3m#", s)
  439.     return sprintf("atom(\"%s\", %.6g, %.6g, %.6g, %.6g, %.6g, %.6g)",
  440.         s, (n-nsub/2)*cwid, textht, (cloc-nsubc/2-0.5)*cwid, crh, crw, dav)
  441. }
  442.  
  443. function inline(    i, n, s, s1, os) {
  444.     s = $0
  445.     os = ""
  446.     while ((n = match(s, /!?[A-Z][A-Za-z]*(([0-9]+\.[0-9]+)|([0-9]+))/)) > 0) {
  447.         os = os substr(s, 1, n-1)    # prefix
  448.         s1 = substr(s, n, RLENGTH)    # molecule
  449.         if (substr(s1, 1, 1) == "!") {    # !mol => leave alone
  450.             s1 = substr(s1, 2)
  451.         } else {
  452.             gsub(/([0-9]+\.[0-9]+)|([0-9]+)/, "\\s-3\\d&\\u\\s+3", s1)
  453.             if (s1 ~ /([^0-9]\.)|(\.[^0-9])/)    # centered dot
  454.                 gsub(/\./, "\\v#-.3m#.\\v#.3m#", s1)
  455.         }
  456.         os = os s1
  457.         s = substr(s, n + RLENGTH)    # tail
  458.     }
  459.     os = os s
  460.     print os
  461.     return
  462. }
  463.  
  464. function shiftfields(n,        i) {    # move $n+1..$NF to $n..$NF-1, zap $NF
  465.     for (i = n; i < NF; i++)
  466.         $i = $(i+1)
  467.     $NF = ""
  468.     NF--
  469. }
  470.  
  471. function fields(n1, n2,        i, s) {
  472.     if (n1 > n2)
  473.         return ""
  474.     s = ""
  475.     for (i = n1; i <= n2; i++) {
  476.         if ($i ~ /^#/)
  477.             break;
  478.         s = s $i " "
  479.     }
  480.     return s
  481. }
  482.  
  483. function set(a, s,     i, n, q) {
  484.     n = split(s, q)
  485.     for (i = 1; i <= n; i += 2)
  486.         a[q[i]] = q[i+1]
  487. }
  488.  
  489. function error(s) {
  490.     printf "chem\007: error on line %d: %s\n", lineno, s | "cat 1>&2"
  491. }
  492.