source: tags/initial/GDE/MOLPHY/Dpstree.c

Last change on this file was 2, checked in by oldcode, 25 years ago

Initial revision
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 10.5 KB
Line 
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
23void
24psdicter(fp)
25FILE *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
98void
99pstree(fp, tr)
100FILE *fp;
101Tree *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
286if (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 */
Note: See TracBrowser for help on using the repository browser.