1 | /* |
---|
2 | * pstree.c Adachi, J. 1996.01.13 |
---|
3 | * Copyright (C) 1995-1996 J. Adachi & M. Hasegawa. All rights reserved. |
---|
4 | */ |
---|
5 | |
---|
6 | #include "protml.h" |
---|
7 | |
---|
8 | #define OTUNUMBERING 0 |
---|
9 | |
---|
10 | #if A4PAPER /* A4 size */ |
---|
11 | #define PAPERHEIGHT 825 /* pt 840 */ |
---|
12 | #define PAPERWIDTH 580 /* pt */ |
---|
13 | #define TREEHEIGHT 700 /* pt */ |
---|
14 | #define TREEWIDTH 450 /* pt */ |
---|
15 | #else /* US letter size (no test) */ |
---|
16 | #define PAPERHEIGHT 784 /* pt */ |
---|
17 | #define PAPERWIDTH 596 /* pt */ |
---|
18 | #define TREEHEIGHT 700 /* pt */ |
---|
19 | #define TREEWIDTH 450 /* pt */ |
---|
20 | #endif |
---|
21 | |
---|
22 | |
---|
23 | void |
---|
24 | psdicter(fp) |
---|
25 | FILE *fp; |
---|
26 | { |
---|
27 | fputs("%\n/$MolphyDict 200 dict def \n", fp); |
---|
28 | fputs("$MolphyDict begin\n", fp); |
---|
29 | fputs("$MolphyDict /mtrx matrix put\n", fp); |
---|
30 | fputs("/Fid /Helvetica-Bold def",fp); |
---|
31 | fputs(" % You can change the font of species name.\n",fp); |
---|
32 | fputs("/Fsc /Helvetica-BoldOblique def",fp); |
---|
33 | fputs(" % You can change the font of scientific name.\n",fp); |
---|
34 | fputs("/Fbp /Helvetica-Narrow def",fp); |
---|
35 | fputs(" % You can change the font of bootstrap probabilities.\n",fp); |
---|
36 | fputs("/FTR /Times-Roman def\n", fp); |
---|
37 | fputs("/FTB /Times-Bold def\n", fp); |
---|
38 | fputs("/FTI /Times-Italic def\n", fp); |
---|
39 | fputs("/FTBI /Times-BoldItalic def\n", fp); |
---|
40 | fputs("/FH /Helvetica def\n", fp); |
---|
41 | fputs("/FHB /Helvetica-Bold def\n", fp); |
---|
42 | fputs("/FHO /Helvetica-Oblique def\n", fp); |
---|
43 | fputs("/FHBO /Helvetica-BoldOblique def\n", fp); |
---|
44 | fputs("/FHN /Helvetica-Narrow def\n", fp); |
---|
45 | fputs("/FS /Symbol def\n", fp); |
---|
46 | fputs("/FBDI /Bookman-DemiItalic def\n", fp); |
---|
47 | fputs("/FNCSI /NewCenturySchlbk-Italic def\n", fp); |
---|
48 | fputs("/ff {findfont} bind def\n", fp); |
---|
49 | fputs("/sf {scalefont setfont} bind def\n", fp); |
---|
50 | fputs("/l {lineto} bind def\n", fp); |
---|
51 | fputs("/m {moveto} bind def\n", fp); |
---|
52 | fputs("/rl {rlineto} bind def\n", fp); |
---|
53 | fputs("/rm {rmoveto} bind def\n", fp); |
---|
54 | fputs("/s {stroke} bind def\n", fp); |
---|
55 | fputs("/n {newpath} bind def\n", fp); |
---|
56 | fputs("/c {closepath} bind def\n", fp); |
---|
57 | fputs("/cp {charpath} bind def\n", fp); |
---|
58 | fputs("/sh {show} bind def\n", fp); |
---|
59 | fputs("/gs {gsave} bind def\n", fp); |
---|
60 | fputs("/gr {grestore} bind def\n", fp); |
---|
61 | fputs("/sg {setgray} bind def\n", fp); |
---|
62 | fputs("/gc {dup dup currentrgbcolor 4 -2 roll mul 4 -2 roll\n", fp); |
---|
63 | fputs("\tmul 4 -2 roll mul setrgbcolor} bind def\n", fp); |
---|
64 | fputs("/CS {dup stringwidth pop neg 2 div 0 rmoveto} def\n", fp); |
---|
65 | fputs("/RS {dup stringwidth pop neg 0 rmoveto} def\n", fp); |
---|
66 | fputs("/RDS {dup stringwidth exch neg exch neg rmoveto} def\n", fp); |
---|
67 | fputs("/BB {stringwidth pop dup neg 0 rl exch 0 exch rl 0 rl c 1 sg fill s 0 sg} def\n", fp); |
---|
68 | fputs("/RR {dup stringwidth pop neg 0 rmoveto show} def\n", fp); |
---|
69 | #if 0 |
---|
70 | fputs("/BP {false charpath gsave 0 setgray fill grestore stroke} def\n", fp); |
---|
71 | #else |
---|
72 | fputs("/BP {show} def\n", fp); |
---|
73 | #endif |
---|
74 | #if 0 |
---|
75 | fputs("/col0 {0 0 0 setrgbcolor} bind def\n", fp); |
---|
76 | fputs("/col1 {0 0 1 setrgbcolor} bind def\n", fp); |
---|
77 | fputs("/col2 {0 1 0 setrgbcolor} bind def\n", fp); |
---|
78 | fputs("/col3 {0 1 1 setrgbcolor} bind def\n", fp); |
---|
79 | fputs("/col4 {1 0 0 setrgbcolor} bind def\n", fp); |
---|
80 | fputs("/col5 {1 0 1 setrgbcolor} bind def\n", fp); |
---|
81 | fputs("/col6 {1 1 0 setrgbcolor} bind def\n", fp); |
---|
82 | fputs("/col7 {1 1 1 setrgbcolor} bind def\n", fp); |
---|
83 | fputs("/col8 {.68 .85 .9 setrgbcolor} bind def\n", fp); |
---|
84 | fputs("/col9 { 0 .39 0 setrgbcolor} bind def\n", fp); |
---|
85 | fputs("/col10 {.65 .17 .17 setrgbcolor} bind def\n", fp); |
---|
86 | fputs("/col11 { 1 .51 0 setrgbcolor} bind def\n", fp); |
---|
87 | fputs("/col12 {.63 .13 .94 setrgbcolor} bind def\n", fp); |
---|
88 | fputs("/col13 { 1 .75 .8 setrgbcolor} bind def\n", fp); |
---|
89 | fputs("/col14 { .7 .13 .13 setrgbcolor} bind def\n", fp); |
---|
90 | fputs("/col15 { 1 .84 0 setrgbcolor} bind def\n", fp); |
---|
91 | #endif |
---|
92 | fputs("end % $MolphyDict\n", fp); |
---|
93 | fputs("/$MolphyBegin {$MolphyDict begin /$MolphyEnteredState save def} def\n", fp); |
---|
94 | fputs("/$MolphyEnd {$MolphyEnteredState restore end} def\n", fp); |
---|
95 | fputs("%%EndProlog\n%\n", fp); |
---|
96 | } /* psdicter */ |
---|
97 | |
---|
98 | void |
---|
99 | pstree(fp, tr) |
---|
100 | FILE *fp; |
---|
101 | Tree *tr; |
---|
102 | { |
---|
103 | Node *cp, *rp, *kp, *bp, *ap; |
---|
104 | char *name, date[32]; |
---|
105 | int len, ns, x, xmax, xs, xsmax, s, smax, y, yi, dy, depth, maxdepth; |
---|
106 | int fonts, fontc, height, width, xorigin, yorigin, db, rel, rfonts, iscale; |
---|
107 | double xscale, yscale, lscale, rfonth, fontw; |
---|
108 | ivector yf, yl; |
---|
109 | |
---|
110 | fputs("%!PS-Adobe-1.0 EPSF-1.0\n", fp); |
---|
111 | fputs("%%Title: (MOLPHY's tree file)\n", fp); |
---|
112 | fprintf(fp, "%%%%Creator: MOLPHY Version %s by Jun Adachi\n", VERSION); |
---|
113 | strftime(date, 32, "%c", localtime(&Ct0)); |
---|
114 | fprintf(fp, "%%%%CreationDate: %s\n", date); |
---|
115 | /* fputs("%%For: Jun Adachi\n", fp); */ |
---|
116 | fputs("%%Orientation: Portrait\n", fp); |
---|
117 | |
---|
118 | xscale = yscale = 1.0; |
---|
119 | ns = Numspc; |
---|
120 | dy = (int)(TREEHEIGHT / (ns + 3)); |
---|
121 | if (dy > 20) { |
---|
122 | dy = 20; |
---|
123 | fonts = 12; |
---|
124 | rfonts = 8; |
---|
125 | } else if (dy > 12) { |
---|
126 | fonts = 10; |
---|
127 | rfonts = 8; |
---|
128 | } else if (dy > 6) { |
---|
129 | fonts = dy - 1; |
---|
130 | rfonts = fonts - 1; |
---|
131 | } else if (dy > 4) { |
---|
132 | fonts = dy; |
---|
133 | rfonts = fonts - 1; |
---|
134 | } else { |
---|
135 | dy = 4; |
---|
136 | fonts = 5; |
---|
137 | rfonts = fonts - 1; |
---|
138 | } |
---|
139 | fontc = (int)(fonts * 2.0 / 5.0); |
---|
140 | fontw = fonts * 0.5; |
---|
141 | rfonts = (int)(fonts*4/5); |
---|
142 | rfonth = rfonts * 0.7; |
---|
143 | db = 1 + (int)(fonts/5); |
---|
144 | height = y = dy * (ns + 3); |
---|
145 | |
---|
146 | x = xsmax = depth = maxdepth = 0; |
---|
147 | |
---|
148 | cp = rp = tr->rootp; |
---|
149 | do { |
---|
150 | cp = cp->isop->kinp; |
---|
151 | len = (int)(cp->length * 10.0 + 0.5); |
---|
152 | if (len == 0) len = 1; |
---|
153 | if (cp->descen) x += len; |
---|
154 | if (cp->isop == NULL) { /* external node */ |
---|
155 | (Sciname[cp->num] && Sciname[cp->num][0] != '\0') ? /* @@@OLIVER */ |
---|
156 | (name = Sciname[cp->num]) : (name = Identif[cp->num]); |
---|
157 | s = (int)(fontw * (strlen(name) + 1) + 10); |
---|
158 | if (Engname[cp->num] && Engname[cp->num][0] != '\0') { /* @@@OLIVER */ |
---|
159 | s += (int)(fontw * (strlen(Engname[cp->num]) + 1)); |
---|
160 | } |
---|
161 | xs = x + s; |
---|
162 | if (xs > xsmax) { |
---|
163 | xsmax = xs; |
---|
164 | xmax = x; |
---|
165 | smax = s; |
---|
166 | } |
---|
167 | cp = cp->kinp; |
---|
168 | } else { /* internal node */ |
---|
169 | if (cp->descen) { |
---|
170 | depth++; |
---|
171 | if (depth > maxdepth) maxdepth = depth; |
---|
172 | } else { |
---|
173 | depth--; |
---|
174 | } |
---|
175 | } |
---|
176 | if (!cp->descen) x -= len; |
---|
177 | } while (cp != rp); |
---|
178 | |
---|
179 | lscale = (double)(TREEWIDTH - smax) / (double)xmax; |
---|
180 | width = TREEWIDTH; |
---|
181 | xorigin = (PAPERWIDTH - width ) / 2; |
---|
182 | yorigin = (PAPERHEIGHT - height) / 2; |
---|
183 | |
---|
184 | fprintf(fp, "%%%%BoundingBox: %d %d %d %d\n", |
---|
185 | xorigin - 5, yorigin, xorigin + width, yorigin + height); |
---|
186 | fputs("%%Pages: 1\n", fp); |
---|
187 | fputs("%%EndComments\n", fp); |
---|
188 | |
---|
189 | psdicter(fp); |
---|
190 | fputs("$MolphyBegin\n", fp); |
---|
191 | |
---|
192 | fprintf(fp, "FTR ff 6 sf"); |
---|
193 | fprintf(fp, " %d %d m", PAPERWIDTH - 10, PAPERHEIGHT - 10); |
---|
194 | strftime(date, 32, "%x", localtime(&Ct0)); |
---|
195 | #ifndef NJ |
---|
196 | fprintf(fp, " (%s %s %s %s %d OTUs %d sites %s) RDS sh %% COMMENT\n", |
---|
197 | Prog_name, VERSION, date, Modelname, Maxspc, Numsite, Comment); |
---|
198 | #else |
---|
199 | fprintf(fp, " (%s %s %s %d OTUs %s) RDS sh %% COMMENT\n", |
---|
200 | Prog_name, VERSION, date, Numspc, Comment); |
---|
201 | #endif |
---|
202 | fprintf(fp, "%% 0.01 setlinewidth n %d %d m %d %d l %d %d l %d %d l c s\n", |
---|
203 | xorigin-5, yorigin, xorigin+width, yorigin, |
---|
204 | xorigin+width, yorigin+height, xorigin-5, yorigin+height); |
---|
205 | |
---|
206 | fprintf(fp, "%d %d translate\n", xorigin, yorigin); |
---|
207 | fprintf(fp, "%.3f %.3f scale\n", xscale, yscale); |
---|
208 | fprintf(fp, "%d setlinecap %d setlinejoin\n", 2, 0); |
---|
209 | fprintf(fp, "%.3f setlinewidth\n", Numspc > 20 ? (0.5) : (1.0)); |
---|
210 | /* |
---|
211 | if (Sciname[0][0] == '\0') |
---|
212 | fprintf(fp, "Fid ff %d sf\n", fonts); |
---|
213 | else |
---|
214 | fprintf(fp, "Fsc ff %d sf\n", fonts); |
---|
215 | */ |
---|
216 | yf = new_ivector(maxdepth + 1); |
---|
217 | yl = new_ivector(maxdepth + 1); |
---|
218 | x = depth = 0; |
---|
219 | |
---|
220 | cp = rp = tr->rootp; |
---|
221 | do { |
---|
222 | bp = cp; |
---|
223 | kp = cp->isop; |
---|
224 | cp = kp->kinp; |
---|
225 | len = (int)(cp->length * 10.0 * lscale + 0.5); |
---|
226 | if (len == 0) len = 1; |
---|
227 | if (cp->descen) x += len; |
---|
228 | if (cp->isop == NULL) { /* external node */ |
---|
229 | y -= dy; |
---|
230 | fprintf(fp, "n %3d %3d m %3d %3d l s ", x - len, y, x, y); |
---|
231 | fprintf(fp, " %3d %3d m", x + (int)fontw, y-fontc); |
---|
232 | fprintf(fp, " %% %3d\n", cp->num+1); |
---|
233 | if (Sciname[cp->num]== 0 || Sciname[cp->num][0] == '\0') { /* @@@OLIVER */ |
---|
234 | fprintf(fp, " Fid ff %d sf (%s) sh", fonts, Identif[cp->num]); |
---|
235 | } else { |
---|
236 | fprintf(fp, " Fsc ff %d sf (%s) sh", fonts, Sciname[cp->num]); |
---|
237 | } |
---|
238 | if (Engname[cp->num] && Engname[cp->num][0] != '\0') { /* @@@OLIVER */ |
---|
239 | fprintf(fp, " Fid ff %d sf ( %s) sh\n",fonts,Engname[cp->num]); |
---|
240 | } else { |
---|
241 | fprintf(fp, "\n"); |
---|
242 | } |
---|
243 | #if OTUNUMBERING |
---|
244 | fprintf(fp, "\t( %d) sh %% otunumbering\n", cp->num+1); |
---|
245 | #endif |
---|
246 | cp = cp->kinp; |
---|
247 | if (bp->descen) yf[depth] = y; |
---|
248 | if (cp->isop->descen) yl[depth] = y; |
---|
249 | if (cp == rp->isop) yf[depth] = y; |
---|
250 | if (cp == rp) yl[depth] = y; |
---|
251 | } else { /* internal node */ |
---|
252 | if (cp->descen) { |
---|
253 | depth++; |
---|
254 | } else { |
---|
255 | yi = (yf[depth] + yl[depth]) / 2; |
---|
256 | depth--; |
---|
257 | if (cp == rp->isop) yf[depth] = yi; |
---|
258 | if (cp == rp) yl[depth] = yi; |
---|
259 | if (cp->isop->descen) { |
---|
260 | yl[depth] = yi; |
---|
261 | } else { |
---|
262 | for (ap = cp; ap->isop != cp; ap = ap->isop) ; |
---|
263 | if (ap->descen) yf[depth] = yi; |
---|
264 | } |
---|
265 | fprintf(fp, "n %3d %3d m %3d %3d l s ", x - len, yi, x, yi); |
---|
266 | fprintf(fp, "n %3d %3d m %3d %3d l s\t%% %3d\n", |
---|
267 | x, yf[depth+1], x, yl[depth+1], cp->num+1); |
---|
268 | } |
---|
269 | } |
---|
270 | if (!cp->descen) x -= len; |
---|
271 | } while (cp != rp); |
---|
272 | fprintf(fp, "n %3d %3d m %3d %3d l s\t%% 0\n", x, yf[depth], x, yl[depth]); |
---|
273 | y -= (dy * 1.0); |
---|
274 | |
---|
275 | if (100*lscale < 400) { |
---|
276 | iscale = 100; |
---|
277 | } else { |
---|
278 | iscale = 10; |
---|
279 | } |
---|
280 | fprintf(fp, "n %3d %3d m %3d %3d l %3d %3d l %3d %3d l s\n", x,y, |
---|
281 | x,y-fontc, x+(int)(iscale*lscale),y-fontc, x+(int)(iscale*lscale),y); |
---|
282 | fprintf(fp, "%%\nFH ff %d sf\n", fonts); |
---|
283 | fprintf(fp, "%3d %3d m (%s substitutions/site) sh\n", |
---|
284 | x, y-fontc-fonts, (iscale == 100 ? "0.1" : "0.01")); |
---|
285 | #ifndef NJ |
---|
286 | if (Relia_optn) { |
---|
287 | fprintf(fp, "%%\nFbp ff %d sf\n", rfonts); /* /FH */ |
---|
288 | y = height; |
---|
289 | x = depth = 0; |
---|
290 | cp = rp = tr->rootp; |
---|
291 | do { |
---|
292 | bp = cp; |
---|
293 | kp = cp->isop; |
---|
294 | cp = kp->kinp; |
---|
295 | len = (int)(cp->length * 10.0 * lscale + 0.5); |
---|
296 | if (len == 0) len = 1; |
---|
297 | if (cp->descen) x += len; |
---|
298 | if (cp->isop == NULL) { /* external node */ |
---|
299 | y -= dy; |
---|
300 | cp = cp->kinp; |
---|
301 | if (bp->descen) yf[depth] = y; |
---|
302 | if (cp->isop->descen) yl[depth] = y; |
---|
303 | if (cp == rp->isop) yf[depth] = y; |
---|
304 | if (cp == rp) yl[depth] = y; |
---|
305 | } else { /* internal node */ |
---|
306 | if (cp->descen) { |
---|
307 | depth++; |
---|
308 | } else { |
---|
309 | yi = (yf[depth] + yl[depth]) / 2; |
---|
310 | depth--; |
---|
311 | if (cp == rp->isop) yf[depth] = yi; |
---|
312 | if (cp == rp) yl[depth] = yi; |
---|
313 | if (cp->isop->descen) { |
---|
314 | yl[depth] = yi; |
---|
315 | } else { |
---|
316 | for (ap = cp; ap->isop != cp; ap = ap->isop) ; |
---|
317 | if (ap->descen) yf[depth] = yi; |
---|
318 | } |
---|
319 | if (Relistat[cp->num - Maxspc] >= 0) { |
---|
320 | rel = (int)(Reliprob[cp->num - Maxspc][0]*100.0+0.5); |
---|
321 | fprintf(fp, "%3d %3d m %.2f (%d) BB ", |
---|
322 | x-db, yi+db, rfonth, rel); |
---|
323 | fprintf(fp, "%3d %3d m (%d) RR\t%% %3d\n", |
---|
324 | x-db, yi+db, rel, cp->num+1); |
---|
325 | /* fprintf(fp, " %3d %3d m gs ", x-db, yi+db); |
---|
326 | fprintf(fp, "(%d) RS BP\n", rel); */ |
---|
327 | } |
---|
328 | } |
---|
329 | } |
---|
330 | if (!cp->descen) x -= len; |
---|
331 | } while (cp != rp); |
---|
332 | } |
---|
333 | #endif /* NJ */ |
---|
334 | |
---|
335 | free_ivector(yf); |
---|
336 | free_ivector(yl); |
---|
337 | |
---|
338 | fputs("%\nshowpage\n", fp); |
---|
339 | fputs("$MolphyEnd\n", fp); |
---|
340 | fputs("% %%EOF\n", fp); |
---|
341 | |
---|
342 | } /* pstree */ |
---|