BEGIN { macros = "/usr/bwk/chem/chem.macros" # CHANGE ME!!!!! macros = "/dev/null" # since originals are lost pi = 3.141592654 deg = 57.29578 setparams(1.0) set(dc, "up 0 right 90 down 180 left 270 ne 45 se 135 sw 225 nw 315") set(dc, "0 n 30 ne 45 ne 60 ne 90 e 120 se 135 se 150 se 180 s") set(dc, "300 nw 315 nw 330 nw 270 w 210 sw 225 sw 240 sw")}function init() { printf ".PS\n" if (firsttime++ == 0) { printf "copy \"%s\"\n", macros printf "\ttextht = %g; textwid = .1; cwid = %g\n", textht, cwid printf "\tlineht = %g; linewid = %g\n", lineht, linewid } printf "Last: 0,0\n" RING = "R"; MOL = "M"; BOND = "B"; OTHER = "O" # manifests last = OTHER dir = 90}function setparams(scale) { lineht = scale * 0.2 linewid = scale * 0.2 textht = scale * 0.16 db = scale * 0.2 # bond length cwid = scale * 0.12 # character width cr = scale * 0.08 # rad of invis circles at ring vertices crh = scale * 0.16 # ht of invis ellipse at ring vertices crw = scale * 0.12 # wid dav = scale * 0.015 # vertical shift up for atoms in atom macro dew = scale * 0.02 # east-west shift for left of/right of ringside = scale * 0.3 # side of all rings dbrack = scale * 0.1 # length of bottom of bracket} { lineno++ } /^(\.cstart)|(begin chem)/ { init(); inchem = 1; next }/^(\.cend)|(end)/ { inchem = 0; print ".PE"; next } /^\./ { print; next } # troff inchem == 0 { print; next } # everything else $1 == "pic" { shiftfields(1); print; next } # pic pass-thru$1 ~ /^#/ { next } # comment $1 == "textht" { textht = $NF; next }$1 == "cwid" { cwid = $NF; next }$1 == "db" { db = $NF; next }$1 == "size" { if ($NF <= 4) size = $NF; else size = $NF/10 setparams(size); next } { print "\n#", $0 } # debugging, etc. { lastname = "" } $1 ~ /^[A-Z].*:$/ { # label; falls thru after shifting left lastname = substr($1, 1, length($1)-1) print $1 shiftfields(1)} $1 ~ /^\"/ { print "Last: ", $0; last = OTHER; next } $1 ~ /bond/ { bond($1); next }$1 ~ /^(double|triple|front|back)$/ && $2 == "bond" { $1 = $1 $2; shiftfields(2); bond($1); next } $1 == "aromatic" { temp = $1; $1 = $2; $2 = temp }$1 ~ /ring|benz/ { ring($1); next } $1 == "methyl" { $1 = "CH3" } # left here as an example $1 ~ /^[A-Z]/ { molecule(); next } $1 == "left" { left[++stack] = fields(2, NF); printf("Last: [\n"); next } $1 == "right" { bracket(); stack--; next } $1 == "label" { label(); next } /./ { print "Last: ", $0; last = OTHER } END { if (firsttime == 0) error("did you forget .cstart and .cend?") if (inchem) printf ".PE\n"} function bond(type, i, goes, from) { goes = "" for (i = 2; i <= NF; i++) if ($i == ";") { goes = $(i+1) NF = i - 1 break } leng = db from = "" for (cf = 2; cf <= NF; ) { if ($cf ~ /(\+|-)?[0-9]+|up|down|right|left|ne|se|nw|sw/) dir = cvtdir(dir) else if ($cf ~ /^leng/) { leng = $(cf+1) cf += 2 } else if ($cf == "to") { leng = 0 from = fields(cf, NF) break } else if ($cf == "from") { from = dofrom() break } else if ($cf ~ /^#/) { cf = NF+1 break; } else { from = fields(cf, NF) break } } if (from ~ /( to )|^to/) # said "from ... to ...", so zap length leng = 0 else if (from == "") # no from given at all from = "from Last." leave(last, dir) " " fields(cf, NF) printf "Last: %s(%g, %g, %s)\n", type, leng, dir, from last = BOND if (lastname != "") labsave(lastname, last, dir) if (goes) { $0 = goes molecule() }} function dofrom( n, s) { cf++ # skip "from" n = $cf if (n in labtype) # "from Thing" => "from Thing.V.s" return "from " n "." leave(labtype[n], dir) if (n ~ /^\.[A-Z]/) # "from .V" => "from Last.V.s" return "from Last" n "." corner(dir) if (n ~ /^[A-Z][^.]*\.[A-Z][^.]*$/) # "from X.V" => "from X.V.s" return "from " n "." corner(dir) return fields(cf-1, NF)} function bracket( t) { printf("]\n") if ($2 == ")") t = "spline" else t = "line" printf("%s from last [].sw+(%g,0) to last [].sw to last [].nw to last [].nw+(%g,0)\n", t, dbrack, dbrack) printf("%s from last [].se-(%g,0) to last [].se to last [].ne to last [].ne-(%g,0)\n", t, dbrack, dbrack) if ($3 == "sub") printf("\" %s\" ljust at last [].se\n", fields(4,NF))} function molecule( n, type) { n = $1 if (n == "BP") { $1 = "\"\" ht 0 wid 0" type = OTHER } else { $1 = atom(n) type = MOL } gsub(/[^A-Za-z0-9]/, "", n) # for stuff like C(OH3): zap non-alnum if ($2 == "") printf "Last: %s: %s with .%s at Last.%s\n", \ n, $0, leave(type,dir+180), leave(last,dir) else if ($2 == "below") printf("Last: %s: %s with .n at %s.s\n", n, $1, $3) else if ($2 == "above") printf("Last: %s: %s with .s at %s.n\n", n, $1, $3) else if ($2 == "left" && $3 == "of") printf("Last: %s: %s with .e at %s.w+(%g,0)\n", n, $1, $4, dew) else if ($2 == "right" && $3 == "of") printf("Last: %s: %s with .w at %s.e-(%g,0)\n", n, $1, $4, dew) else printf "Last: %s: %s\n", n, $0 last = type if (lastname != "") labsave(lastname, last, dir) labsave(n, last, dir)} function label( i, v) { if (substr(labtype[$2], 1, 1) != RING) error(sprintf("%s is not a ring", $2)) else { v = substr(labtype[$2], 2, 1) for (i = 1; i <= v; i++) printf("\"\\s-3%d\\s0\" at 0.%d<%s.C,%s.V%d>\n", i, v+2, $2, $2, i) }} function ring(type, typeint, pt, verts, i) { pt = 0 # points up by default if (type ~ /[1-8]$/) verts = substr(type, length(type), 1) else if (type ~ /flat/) verts = 5 else verts = 6 fused = other = "" for (i = 1; i <= verts; i++) put[i] = dbl[i] = "" nput = aromatic = withat = 0 for (cf = 2; cf <= NF; ) { if ($cf == "pointing") pt = cvtdir(0) else if ($cf == "double" || $cf == "triple") dblring(verts) else if ($cf ~ /arom/) { aromatic++ cf++ # handled later } else if ($cf == "put") { putring(verts) nput++ } else if ($cf ~ /^#/) { cf = NF+1 break; } else { if ($cf == "with" || $cf == "at") withat = 1 other = other " " $cf cf++ } } typeint = RING verts pt # RING | verts | dir if (withat == 0) fused = joinring(typeint, dir, last) printf "Last: [\n" makering(type, pt, verts) printf "] %s %s\n", fused, other last = typeint if (lastname != "") labsave(lastname, last, dir)} function makering(type, pt, v, i, a, r) { if (type ~ /flat/) v = 6 # vertices r = ringside / (2 * sin(pi/v)) printf "\tC: 0,0\n" for (i = 0; i <= v+1; i++) { a = ((i-1) / v * 360 + pt) / deg printf "\tV%d: (%g,%g)\n", i, r * sin(a), r * cos(a) } if (type ~ /flat/) { printf "\tV4: V5; V5: V6\n" v = 5 } # sides if (nput > 0) { # hetero ... for (i = 1; i <= v; i++) { c1 = c2 = 0 if (put[i] != "") { printf("\tV%d: ellipse invis ht %g wid %g at V%d\n", i, crh, crw, i) printf("\t%s at V%d\n", put[i], i) c1 = cr } j = i+1 if (j > v) j = 1 if (put[j] != "") c2 = cr printf "\tline from V%d to V%d chop %g chop %g\n", i, j, c1, c2 if (dbl[i] != "") { # should check i<j if (type ~ /flat/ && i == 3) { rat = 0.75; fix = 5 } else { rat = 0.85; fix = 1.5 } if (put[i] == "") c1 = 0 else c1 = cr/fix if (put[j] == "") c2 = 0 else c2 = cr/fix printf "\tline from %g<C,V%d> to %g<C,V%d> chop %g chop %g\n", rat, i, rat, j, c1, c2 if (dbl[i] == "triple") printf "\tline from %g<C,V%d> to %g<C,V%d> chop %g chop %g\n", 2-rat, i, 2-rat, j, c1, c2 } } } else { # regular for (i = 1; i <= v; i++) { j = i+1 if (j > v) j = 1 printf "\tline from V%d to V%d\n", i, j if (dbl[i] != "") { # should check i<j if (type ~ /flat/ && i == 3) { rat = 0.75 } else rat = 0.85 printf "\tline from %g<C,V%d> to %g<C,V%d>\n", rat, i, rat, j if (dbl[i] == "triple") printf "\tline from %g<C,V%d> to %g<C,V%d>\n", 2-rat, i, 2-rat, j } } } # punt on triple temporarily # circle if (type ~ /benz/ || aromatic > 0) { if (type ~ /flat/) r *= .4 else r *= .5 printf "\tcircle rad %g at 0,0\n", r }} function putring(v) { # collect "put Mol at n" cf++ mol = $(cf++) if ($cf == "at") cf++ if ($cf >= 1 && $cf <= v) { m = mol gsub(/[^A-Za-z0-9]/, "", m) put[$cf] = m ":" atom(mol) } cf++} function joinring(type, dir, last) { # join a ring to something if (substr(last, 1, 1) == RING) { # ring to ring if (substr(type, 3) == substr(last, 3)) # fails if not 6-sided return "with .V6 at Last.V2" } # if all else fails return sprintf("with .%s at Last.%s", \ leave(type,dir+180), leave(last,dir))} function leave(last, d, c, c1) { # return vertex of last in dir d if (last == BOND) return "end" d = reduce(d) if (substr(last, 1, 1) == RING) return ringleave(last, d) if (last == MOL) { if (d == 0 || d == 180) c = "C" else if (d > 0 && d < 180) c = "R" else c = "L" if (d in dc) c1 = dc[d] else c1 = corner(d) return sprintf("%s.%s", c, c1) } if (last == OTHER) return corner(d) return "c"} function ringleave(last, d, rd, verts) { # return vertex of ring in dir d verts = substr(last, 2, 1) rd = substr(last, 3) return sprintf("V%d.%s", int(reduce(d-rd)/(360/verts)) + 1, corner(d))} function corner(dir) { return dc[reduce(45 * int((dir+22.5)/45))]} function labsave(name, type, dir) { labtype[name] = type labdir[name] = dir} function dblring(v, d, v1, v2) { # should canonicalize to i,i+1 mod v d = $cf for (cf++; $cf ~ /^[1-9]/; cf++) { v1 = substr($cf,1,1) v2 = substr($cf,3,1) if (v2 == v1+1 || v1 == v && v2 == 1) # e.g., 2,3 or 5,1 dbl[v1] = d else if (v1 == v2+1 || v2 == v && v1 == 1) # e.g., 3,2 or 1,5 dbl[v2] = d else error(sprintf("weird %s bond in\n\t%s", d, $0)) }} function cvtdir(d) { # maps "[pointing] somewhere" to degrees if ($cf == "pointing") cf++ if ($cf ~ /^[+\-]?[0-9]+/) return reduce($(cf++)) else if ($cf ~ /left|right|up|down|ne|nw|se|sw/) return reduce(dc[$(cf++)]) else { cf++ return d }} function reduce(d) { # reduces d to 0 <= d < 360 while (d >= 360) d -= 360 while (d < 0) d += 360 return d} function atom(s, c, i, n, nsub, cloc, nsubc) { # convert CH3 to atom(...) if (s == "\"\"") return s n = length(s) nsub = nsubc = 0 cloc = index(s, "C") if (cloc == 0) cloc = 1 for (i = 1; i <= n; i++) if (substr(s, i, 1) !~ /[A-Z]/) { nsub++ if (i < cloc) nsubc++ } gsub(/([0-9]+\.[0-9]+)|([0-9]+)/, "\\s-3\\d&\\u\\s+3", s) if (s ~ /([^0-9]\.)|(\.[^0-9])/) # centered dot gsub(/\./, "\\v#-.3m#.\\v#.3m#", s) return sprintf("atom(\"%s\", %g, %g, %g, %g, %g, %g)", s, (n-nsub/2)*cwid, textht, (cloc-nsubc/2-0.5)*cwid, crh, crw, dav)} function in_line( i, n, s, s1, os) { s = $0 os = "" while ((n = match(s, /!?[A-Z][A-Za-z]*(([0-9]+\.[0-9]+)|([0-9]+))/)) > 0) { os = os substr(s, 1, n-1) # prefix s1 = substr(s, n, RLENGTH) # molecule if (substr(s1, 1, 1) == "!") { # !mol => leave alone s1 = substr(s1, 2) } else { gsub(/([0-9]+\.[0-9]+)|([0-9]+)/, "\\s-3\\d&\\u\\s+3", s1) if (s1 ~ /([^0-9]\.)|(\.[^0-9])/) # centered dot gsub(/\./, "\\v#-.3m#.\\v#.3m#", s1) } os = os s1 s = substr(s, n + RLENGTH) # tail } os = os s print os return} function shiftfields(n, i) { # move $n+1..$NF to $n..$NF-1, zap $NF for (i = n; i < NF; i++) $i = $(i+1) $NF = "" NF--} function fields(n1, n2, i, s) { if (n1 > n2) return "" s = "" for (i = n1; i <= n2; i++) { if ($i ~ /^#/) break; s = s $i " " } return s} function set(a, s, i, n, q) { n = split(s, q) for (i = 1; i <= n; i += 2) a[q[i]] = q[i+1]} function error(s) { printf "chem\007: error on line %d: %s\n", lineno, s | "cat 1>&2"}
BEGIN {
macros = "/usr/bwk/chem/chem.macros" # CHANGE ME!!!!!
macros = "/dev/null" # since originals are lost
pi = 3.141592654
deg = 57.29578
setparams(1.0)
set(dc, "up 0 right 90 down 180 left 270 ne 45 se 135 sw 225 nw 315")
set(dc, "0 n 30 ne 45 ne 60 ne 90 e 120 se 135 se 150 se 180 s")
set(dc, "300 nw 315 nw 330 nw 270 w 210 sw 225 sw 240 sw")
}
function init() {
printf ".PS\n"
if (firsttime++ == 0) {
printf "copy \"%s\"\n", macros
printf "\ttextht = %g; textwid = .1; cwid = %g\n", textht, cwid
printf "\tlineht = %g; linewid = %g\n", lineht, linewid
}
printf "Last: 0,0\n"
RING = "R"; MOL = "M"; BOND = "B"; OTHER = "O" # manifests
last = OTHER
dir = 90
}
function setparams(scale) {
lineht = scale * 0.2
linewid = scale * 0.2
textht = scale * 0.16
db = scale * 0.2 # bond length
cwid = scale * 0.12 # character width
cr = scale * 0.08 # rad of invis circles at ring vertices
crh = scale * 0.16 # ht of invis ellipse at ring vertices
crw = scale * 0.12 # wid
dav = scale * 0.015 # vertical shift up for atoms in atom macro
dew = scale * 0.02 # east-west shift for left of/right of
ringside = scale * 0.3 # side of all rings
dbrack = scale * 0.1 # length of bottom of bracket
}
{ lineno++ }
/^(\.cstart)|(begin chem)/ { init(); inchem = 1; next }
/^(\.cend)|(end)/ { inchem = 0; print ".PE"; next }
/^\./ { print; next } # troff
inchem == 0 { print; next } # everything else
$1 == "pic" { shiftfields(1); print; next } # pic pass-thru
$1 ~ /^#/ { next } # comment
$1 == "textht" { textht = $NF; next }
$1 == "cwid" { cwid = $NF; next }
$1 == "db" { db = $NF; next }
$1 == "size" { if ($NF <= 4) size = $NF; else size = $NF/10
setparams(size); next }
{ print "\n#", $0 } # debugging, etc.
{ lastname = "" }
$1 ~ /^[A-Z].*:$/ { # label; falls thru after shifting left
lastname = substr($1, 1, length($1)-1)
print $1
shiftfields(1)
}
$1 ~ /^\"/ { print "Last: ", $0; last = OTHER; next }
$1 ~ /bond/ { bond($1); next }
$1 ~ /^(double|triple|front|back)$/ && $2 == "bond" {
$1 = $1 $2; shiftfields(2); bond($1); next }
$1 == "aromatic" { temp = $1; $1 = $2; $2 = temp }
$1 ~ /ring|benz/ { ring($1); next }
$1 == "methyl" { $1 = "CH3" } # left here as an example
$1 ~ /^[A-Z]/ { molecule(); next }
$1 == "left" { left[++stack] = fields(2, NF); printf("Last: [\n"); next }
$1 == "right" { bracket(); stack--; next }
$1 == "label" { label(); next }
/./ { print "Last: ", $0; last = OTHER }
END { if (firsttime == 0) error("did you forget .cstart and .cend?")
if (inchem) printf ".PE\n"
}
function bond(type, i, goes, from) {
goes = ""
for (i = 2; i <= NF; i++)
if ($i == ";") {
goes = $(i+1)
NF = i - 1
break
}
leng = db
from = ""
for (cf = 2; cf <= NF; ) {
if ($cf ~ /(\+|-)?[0-9]+|up|down|right|left|ne|se|nw|sw/)
dir = cvtdir(dir)
else if ($cf ~ /^leng/) {
leng = $(cf+1)
cf += 2
} else if ($cf == "to") {
leng = 0
from = fields(cf, NF)
break
} else if ($cf == "from") {
from = dofrom()
break
} else if ($cf ~ /^#/) {
cf = NF+1
break;
} else {
from = fields(cf, NF)
break
}
}
if (from ~ /( to )|^to/) # said "from ... to ...", so zap length
leng = 0
else if (from == "") # no from given at all
from = "from Last." leave(last, dir) " " fields(cf, NF)
printf "Last: %s(%g, %g, %s)\n", type, leng, dir, from
last = BOND
if (lastname != "")
labsave(lastname, last, dir)
if (goes) {
$0 = goes
molecule()
}
}
function dofrom( n, s) {
cf++ # skip "from"
n = $cf
if (n in labtype) # "from Thing" => "from Thing.V.s"
return "from " n "." leave(labtype[n], dir)
if (n ~ /^\.[A-Z]/) # "from .V" => "from Last.V.s"
return "from Last" n "." corner(dir)
if (n ~ /^[A-Z][^.]*\.[A-Z][^.]*$/) # "from X.V" => "from X.V.s"
return "from " n "." corner(dir)
return fields(cf-1, NF)
}
function bracket( t) {
printf("]\n")
if ($2 == ")")
t = "spline"
else
t = "line"
printf("%s from last [].sw+(%g,0) to last [].sw to last [].nw to last [].nw+(%g,0)\n",
t, dbrack, dbrack)
printf("%s from last [].se-(%g,0) to last [].se to last [].ne to last [].ne-(%g,0)\n",
t, dbrack, dbrack)
if ($3 == "sub")
printf("\" %s\" ljust at last [].se\n", fields(4,NF))
}
function molecule( n, type) {
n = $1
if (n == "BP") {
$1 = "\"\" ht 0 wid 0"
type = OTHER
} else {
$1 = atom(n)
type = MOL
}
gsub(/[^A-Za-z0-9]/, "", n) # for stuff like C(OH3): zap non-alnum
if ($2 == "")
printf "Last: %s: %s with .%s at Last.%s\n", \
n, $0, leave(type,dir+180), leave(last,dir)
else if ($2 == "below")
printf("Last: %s: %s with .n at %s.s\n", n, $1, $3)
else if ($2 == "above")
printf("Last: %s: %s with .s at %s.n\n", n, $1, $3)
else if ($2 == "left" && $3 == "of")
printf("Last: %s: %s with .e at %s.w+(%g,0)\n", n, $1, $4, dew)
else if ($2 == "right" && $3 == "of")
printf("Last: %s: %s with .w at %s.e-(%g,0)\n", n, $1, $4, dew)
else
printf "Last: %s: %s\n", n, $0
last = type
if (lastname != "")
labsave(lastname, last, dir)
labsave(n, last, dir)
}
function label( i, v) {
if (substr(labtype[$2], 1, 1) != RING)
error(sprintf("%s is not a ring", $2))
else {
v = substr(labtype[$2], 2, 1)
for (i = 1; i <= v; i++)
printf("\"\\s-3%d\\s0\" at 0.%d<%s.C,%s.V%d>\n", i, v+2, $2, $2, i)
}
}
function ring(type, typeint, pt, verts, i) {
pt = 0 # points up by default
if (type ~ /[1-8]$/)
verts = substr(type, length(type), 1)
else if (type ~ /flat/)
verts = 5
else
verts = 6
fused = other = ""
for (i = 1; i <= verts; i++)
put[i] = dbl[i] = ""
nput = aromatic = withat = 0
for (cf = 2; cf <= NF; ) {
if ($cf == "pointing")
pt = cvtdir(0)
else if ($cf == "double" || $cf == "triple")
dblring(verts)
else if ($cf ~ /arom/) {
aromatic++
cf++ # handled later
} else if ($cf == "put") {
putring(verts)
nput++
} else if ($cf ~ /^#/) {
cf = NF+1
break;
} else {
if ($cf == "with" || $cf == "at")
withat = 1
other = other " " $cf
cf++
}
}
typeint = RING verts pt # RING | verts | dir
if (withat == 0)
fused = joinring(typeint, dir, last)
printf "Last: [\n"
makering(type, pt, verts)
printf "] %s %s\n", fused, other
last = typeint
if (lastname != "")
labsave(lastname, last, dir)
}
function makering(type, pt, v, i, a, r) {
if (type ~ /flat/)
v = 6
# vertices
r = ringside / (2 * sin(pi/v))
printf "\tC: 0,0\n"
for (i = 0; i <= v+1; i++) {
a = ((i-1) / v * 360 + pt) / deg
printf "\tV%d: (%g,%g)\n", i, r * sin(a), r * cos(a)
}
if (type ~ /flat/) {
printf "\tV4: V5; V5: V6\n"
v = 5
}
# sides
if (nput > 0) { # hetero ...
for (i = 1; i <= v; i++) {
c1 = c2 = 0
if (put[i] != "") {
printf("\tV%d: ellipse invis ht %g wid %g at V%d\n",
i, crh, crw, i)
printf("\t%s at V%d\n", put[i], i)
c1 = cr
}
j = i+1
if (j > v)
j = 1
if (put[j] != "")
c2 = cr
printf "\tline from V%d to V%d chop %g chop %g\n", i, j, c1, c2
if (dbl[i] != "") { # should check i<j
if (type ~ /flat/ && i == 3) {
rat = 0.75; fix = 5
} else {
rat = 0.85; fix = 1.5
}
if (put[i] == "")
c1 = 0
else
c1 = cr/fix
if (put[j] == "")
c2 = 0
else
c2 = cr/fix
printf "\tline from %g<C,V%d> to %g<C,V%d> chop %g chop %g\n",
rat, i, rat, j, c1, c2
if (dbl[i] == "triple")
printf "\tline from %g<C,V%d> to %g<C,V%d> chop %g chop %g\n",
2-rat, i, 2-rat, j, c1, c2
}
}
} else { # regular
for (i = 1; i <= v; i++) {
j = i+1
if (j > v)
j = 1
printf "\tline from V%d to V%d\n", i, j
if (dbl[i] != "") { # should check i<j
if (type ~ /flat/ && i == 3) {
rat = 0.75
} else
rat = 0.85
printf "\tline from %g<C,V%d> to %g<C,V%d>\n",
rat, i, rat, j
if (dbl[i] == "triple")
printf "\tline from %g<C,V%d> to %g<C,V%d>\n",
2-rat, i, 2-rat, j
}
}
}
# punt on triple temporarily
# circle
if (type ~ /benz/ || aromatic > 0) {
if (type ~ /flat/)
r *= .4
else
r *= .5
printf "\tcircle rad %g at 0,0\n", r
}
}
function putring(v) { # collect "put Mol at n"
cf++
mol = $(cf++)
if ($cf == "at")
cf++
if ($cf >= 1 && $cf <= v) {
m = mol
gsub(/[^A-Za-z0-9]/, "", m)
put[$cf] = m ":" atom(mol)
}
cf++
}
function joinring(type, dir, last) { # join a ring to something
if (substr(last, 1, 1) == RING) { # ring to ring
if (substr(type, 3) == substr(last, 3)) # fails if not 6-sided
return "with .V6 at Last.V2"
}
# if all else fails
return sprintf("with .%s at Last.%s", \
leave(type,dir+180), leave(last,dir))
}
function leave(last, d, c, c1) { # return vertex of last in dir d
if (last == BOND)
return "end"
d = reduce(d)
if (substr(last, 1, 1) == RING)
return ringleave(last, d)
if (last == MOL) {
if (d == 0 || d == 180)
c = "C"
else if (d > 0 && d < 180)
c = "R"
else
c = "L"
if (d in dc)
c1 = dc[d]
else
c1 = corner(d)
return sprintf("%s.%s", c, c1)
}
if (last == OTHER)
return corner(d)
return "c"
}
function ringleave(last, d, rd, verts) { # return vertex of ring in dir d
verts = substr(last, 2, 1)
rd = substr(last, 3)
return sprintf("V%d.%s", int(reduce(d-rd)/(360/verts)) + 1, corner(d))
}
function corner(dir) {
return dc[reduce(45 * int((dir+22.5)/45))]
}
function labsave(name, type, dir) {
labtype[name] = type
labdir[name] = dir
}
function dblring(v, d, v1, v2) { # should canonicalize to i,i+1 mod v
d = $cf
for (cf++; $cf ~ /^[1-9]/; cf++) {
v1 = substr($cf,1,1)
v2 = substr($cf,3,1)
if (v2 == v1+1 || v1 == v && v2 == 1) # e.g., 2,3 or 5,1
dbl[v1] = d
else if (v1 == v2+1 || v2 == v && v1 == 1) # e.g., 3,2 or 1,5
dbl[v2] = d
else
error(sprintf("weird %s bond in\n\t%s", d, $0))
}
}
function cvtdir(d) { # maps "[pointing] somewhere" to degrees
if ($cf == "pointing")
cf++
if ($cf ~ /^[+\-]?[0-9]+/)
return reduce($(cf++))
else if ($cf ~ /left|right|up|down|ne|nw|se|sw/)
return reduce(dc[$(cf++)])
else {
cf++
return d
}
}
function reduce(d) { # reduces d to 0 <= d < 360
while (d >= 360)
d -= 360
while (d < 0)
d += 360
return d
}
function atom(s, c, i, n, nsub, cloc, nsubc) { # convert CH3 to atom(...)
if (s == "\"\"")
return s
n = length(s)
nsub = nsubc = 0
cloc = index(s, "C")
if (cloc == 0)
cloc = 1
for (i = 1; i <= n; i++)
if (substr(s, i, 1) !~ /[A-Z]/) {
nsub++
if (i < cloc)
nsubc++
}
gsub(/([0-9]+\.[0-9]+)|([0-9]+)/, "\\s-3\\d&\\u\\s+3", s)
if (s ~ /([^0-9]\.)|(\.[^0-9])/) # centered dot
gsub(/\./, "\\v#-.3m#.\\v#.3m#", s)
return sprintf("atom(\"%s\", %g, %g, %g, %g, %g, %g)",
s, (n-nsub/2)*cwid, textht, (cloc-nsubc/2-0.5)*cwid, crh, crw, dav)
}
function in_line( i, n, s, s1, os) {
s = $0
os = ""
while ((n = match(s, /!?[A-Z][A-Za-z]*(([0-9]+\.[0-9]+)|([0-9]+))/)) > 0) {
os = os substr(s, 1, n-1) # prefix
s1 = substr(s, n, RLENGTH) # molecule
if (substr(s1, 1, 1) == "!") { # !mol => leave alone
s1 = substr(s1, 2)
} else {
gsub(/([0-9]+\.[0-9]+)|([0-9]+)/, "\\s-3\\d&\\u\\s+3", s1)
if (s1 ~ /([^0-9]\.)|(\.[^0-9])/) # centered dot
gsub(/\./, "\\v#-.3m#.\\v#.3m#", s1)
}
os = os s1
s = substr(s, n + RLENGTH) # tail
}
os = os s
print os
return
}
function shiftfields(n, i) { # move $n+1..$NF to $n..$NF-1, zap $NF
for (i = n; i < NF; i++)
$i = $(i+1)
$NF = ""
NF--
}
function fields(n1, n2, i, s) {
if (n1 > n2)
return ""
s = ""
for (i = n1; i <= n2; i++) {
if ($i ~ /^#/)
break;
s = s $i " "
}
return s
}
function set(a, s, i, n, q) {
n = split(s, q)
for (i = 1; i <= n; i += 2)
a[q[i]] = q[i+1]
}
function error(s) {
printf "chem\007: error on line %d: %s\n", lineno, s | "cat 1>&2"
}