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