/* Output from p2c 1.21alpha-07.Dec.93, the Pascal-to-C translator */ /* From input file "alist.p" */ #include /* aligned listing of a book. Dr. Thomas D. Schneider National Institutes of Health National Cancer Institute Center for Cancer Research Nanobiology Program Molecular Information Theory Group Frederick, Maryland 21702-1201 toms@ncifcrf.gov permanent email: toms@alum.mit.edu (use only if first address fails) http://www.ccrnp.ncifcrf.gov/~toms/ module libraries: delman, delmods, prgmods */ /* end of program */ /* begin module version */ #define version 6.58 /* of alist.p 2007 Nov 29 2007 Nov 29: 6.58: ury of bounding box huge when multiple pages; fix page line ogic 2007 Jun 22: 6.57: 'The piece name in the book' - allow dotted names 2005 Sep 21: 6.56: emptyfile should reset the file so reads are ok! 2005 Sep 19: 6.55: cleanup 2005 Sep 19: 6.54: REALLY set the boundary at 2 characters in emptyfile. 2005 Sep 15: 6.53: set the boundary at 2 characters in emptyfile. 2005 Sep 15: 6.52: namewidth problem ... I kludged it for now. the namebook and namelist files normally would have at least 5 characters. So this was used as the test for 'empty'. See the emptyfile routine. The emptyfile routine replaces eof() in several places. 2005 Sep 13: 6.51: fix namewidth so it works with gpc! ... no must use new compiler. 2005 Sep 13: 6.50: delmod module upgrade 2005 Jan 27: 6.49: Abandon changes in 47 and 46, keep f function. It seems impossible to detect an empty file using the GPC compiler! THIS PROGRAM MUST BE COMILED WITH p2c (tc script)!!! 2005 Jan 27: 6.47: BUG: emptyfile routine to detect empty files. 2005 Jan 27: 6.46: BUG: In GPC, an empty file is not at eof when reset. How nice! So the namelistwidth failed. 2005 Jan 27: 6.45: postscript f function for setting fonts. 2004 Sep 8: 6.44: clean for GPC 2004 Aug 30: 6.43: maximum range set to 1001 2004 Jul 17: 6.42: delila mutation names not shown correctly 2004 Jul 11: 6.41: only display orientation if piece is given 2004 Jul 8: 6.40: upgrad to prgmod, isblank to work on all compilers 2004 Jul 7: 6.39: bug in reading bounding boxes 2004 Jun 7: 6.38: bounding box must be integers, not real 2002 Sep 5: 6.37: remove debugging residue, upgrade page boundaries 2002 Sep 5: 6.36: clean documentation 2002 Apr 19: 6.35: introduce line number control 2002 Jan 13: 6.34: upgrade documentation; mention version parameter line! 2001 Nov 5: 6.33: paging is NOT done to clist at all times! 2001 Aug 29: 6.32: edgecontrol variables written to clist are in cm 2001 Mar 26: 6.31: allow coordinate without piece name 2001 Mar 26: 6.30: check for 'program list header problem' neutralized. 2000 Nov 16: 6.28: fix reading of name instruction in delmod 2000 Nov 16: 6.27: gpc compatable! 2000 Oct 16: 6.26: increment maximumrange 2000 Jul 13: 6.25: tech notes about autoupgrade 2000 Jun 28: 6.24: headercontrol: 0 = no numbar 2000 Jun 24: 6.23: expand range to +/-1000 2000 Jun 24: 6.19: allow user to remove header by a parameter 2000 Jun 24: 6.12: precompute number oflines to make ghostview display tight. 2000 Jun 21: 6.07: full position of display controls installed, finally! 2000 Jun 21: 5.96: old parameter files are now automatically upgraded! 2000 Jun 20: 5.93: pnumberbar modified to use numberbar so it auto-upgrades! 2000 Jun 20: 5.90: introducing edgecontrol from makelogo 2000 May 10: 5.80: getname and printname now use getocp - very clean!!! 1999 Jul 24: 5.79: numberwidth is computed only in numbersize 1999 May 18: set bounding box for for the Canon Color Laser Copier 800S 1998 Oct 19: range set to 1000 origin before 1982 June 22 */ #define updateversion 6.20 /* defines lowest acceptable current parameter file */ /* end module version */ /* begin module describe.alist */ /* name alist: aligned listing of a book synopsis alist(inst: in, book: in, alistp: inout, colors: in, namebook: in, namelist: in, avalues: in, list: out, clist: out, output: out) files inst: delila instructions of the form 'get from 56 -5 to 56 +10;' If this file is empty, then the sequences will be aligned either by their 5' ends or by their zero base, depending on the 4th parameter in alistp. book: the book generated by delila using inst alistp: parameters to control the program. If empty, the range of the instructions are used. Otherwise, 0. The version of alist that this parameter file is designed for. If the program finds an old version, it will *upgrade* the alistp file. 1. The first line contains one line with two integers defining the range of basesto display. This allows one to have a wide alignment, but look only at a portion. 2. If the first character of the second line is: 'p' the piece name and coordinates are given in the list. If it is ' ' then neither is given. If one has only one piece that one is working with, one may not want the piece name but will want the coordinate In this case use 'c'. If the second character is 'l', then the long name of the piece is given in the list preceeding the piece name. Note that this long name can be written into the book from the instructions by the Delila "name" instruction. (See in the libdef.) Blank names (ie, 'name "";') are accepted. 3. If the first character of the third line is 'n' then paging is not done to the list. 4. If the first character of the fourth line is 'f' (for 'first') then the sequences are always aligned by their first base. 'i' then the sequences are aligned by the delila instructions. If the inst file is empty, alignment is forced to the 'b' mode. 'b' (for 'internal') then the alignment is on the internal zero of the book's sequence. This option is to be used when "default coordinate zero" is used in the Delila instructions. The following table should clarify the cases and their uses: state |instructions empty | instructions exist ------|-------------------|------------------------------------------- | | instruction alignment | book alignment | | (def coo nor) | (def coo zer) |-------------------|------------------------|------------------ 'f' | first base | first base | first base | (first base) | (first base) | (first base) |-------------------|------------------------|------------------ 'i' | book | inst | inst (DO NOT USE) | (0) | (aligning base) | (aligning base) |-------------------|------------------------|------------------ 'b' | book | book (DO NOT USE) | book | (0) | (0) | (0) The first line of each entry defines how the alignment will be assigned. Thus 'f' forces the first base to be used at all times and 'b' forces the book to be used. In two case this does not make sense. First, if the instructions were generated with the "default coordinate zero", then the Delila instructions do not correspond to the base coordinates in the book (by definition) and so the alignment should not use the instruction file. In the second case, the instructions use "default coordinate normal" so the zero base in the book does not correspond to the zero base in the instructions. The basic problem here is that there is no way for the program to know which situation occurs, without spending time reading the Delila instructions. So the user must specify. (This may be automated in the future.) The second line of each entry is the coordinate number which appears on the left column of the aligned listing. 5. Column number to read from avalues file (integer), followed by the field width and number of decimal places to write the values to the list and clist. 6. edgecontrol edgeleft, edgeright, edgelow, edgehigh: edgecontrol is a single character that controls how the bounding box of the figure is handled. If it is 'p' then the bounding box will be the page parameters defined in constants inside the program (llx, lly, urx, ury). Otherwise, there are four real numbers that define the edges around the clist in cm. To allow a clist to be imbedded into another figure, its size must be defined in PostScript (with %%BoundingBox). By setting these four numbers, the edges are defined. 7. map control: A series of values: * mapcontrol: If the first character on the line is a 'C', then the color map file will be written. If it is 'R' then the page will be set up so that the upper left corner is moved to the lower left corner and the image is rotated 90 degrees counter clockwise. This has the effect of making the image in "landscape" mode. * fontsize (integer): The character height in points (there are 72 points/inch, 2.54 cm/inch). Typical value for alist: 15. 8. deltaXcm deltaYcm scaleimage: image positioning controls * deltaXcm: The amount to move the image in X (cm). * deltaYcm: The amount to move the image in Y (cm). * scaleimage: the scaling factor. The image will be shifted on the printed page. X is positive to the right and Y is positive up the page. Generally one would use positive values for X and negative values of Y since the image should otherwise fit snugly in the upper left corner of the page. The scaling is performed after movement from the lower left hand corner of the image as one would read it. If the image has been put in "landscape" mode the delta-shifts are given in the new coordinate system. This allows one to switch between "landscape" and regular "portrait" mode without changing the parameters, and it allows one to think in terms of a normally held page. 9. headercontrol: the first character on the line determines whether the header description is written to list and clist. If the character is 'h' it is written, otherwise not. Headers can also be removed from the clist by deleting lines containing the word "NOHEADER". In Unix this is done by: grep -v clist NOHEADER > clist.noheader With 'h' the numbar (bar of vertically written numbers) is included above the sequence, but if the character is '0' (zero) the numbar is not written. This allows one to use the list file to extract column data easily, otherwise it is not recommended. namebook: names of genes or transcripts from this book appear in the list. If namebook is empty, then only the items specified in alistp are given. namelist: if this file is not empty, then it should contain a simple list of names to give to each sequence listed. These are placed to the left of the alist and may contain anything one wants. The number of columns used is determined by the longest line in the file. avalues: Aligned list values. A file containing values to list for each of the sequences. If the file is not empty, the values appear to the right of the sequences. The first line of the file is expected to begin with "* " followed by the title of the values. All other lines that begin with "*" are ignored. The program uses the data column of avalues as defined in the alistp parameter file. list: the aligned listing clist: the aligned listing, in PostScript color. Paging is ALWAYS done to this file, using the page parameter. However, it can be removed by deleting all lines with the word "REMOVE" on them. This is easily done in Unix with: grep -v clist REMOVE colors: colors defining the bases, see makelogo for definition. output: messages to the user description Alist creates an aligned listing of a sets of sequences. The pieces in the book are aligned according to the instructions in file inst, and listed in the list file. Each piece is identified, and a bar of numbers (called a 'numbar') that are read vertically defines the locations of bases around the aligning point. example To generate an example input set using namebook, start with a set of instructions that name genes and get them (as 'get from gene beginning -0 to gene beginning +2;'). Produce namebook. Check for genes that are reversed relative to the piece (use hist and alist without instructions), and correct the delila instructions. To convert these instructions to absolute form, use program search with 'd f -54321 t +12345 q atg gtg ttg' on namebook. Now convert -54321 and +12345 to the range of interest (beware of absolute locations with the same numbers). Finally, generate the book using delila. (Someday this process will be simpler.) Here are some search instructions (file: sea): * instructions for the input file of the search program d q #gtt ~ = q (The blanks at the beginning of each line protect from the compiler detecting the # on the first line, and should be removed to try this example.) When these are given to search along with the book 'exobk': cp ex0bk book search < sea The inst file is: title "95/01/24 21:12:11 search 6.05"; (@ * 86/12/12 13:06:31, 84/05/05 21:12:50, ex0: example @) default numbering piece; default numbering 1; default out-of-range reduce-range; default coordinate zero; (@ typed pattern: "#gtt" @) organism ecoli; chromosome ecoli; piece lac; get from 43 -100 to 43 +100 direction +; (@ the complementary search string is now: "aa#c" @) (@ typed pattern: "aa#c" @) piece lac; get from 35 +100 to 35 -100 direction -; get from 42 +100 to 42 -100 direction -; (The '*' of comments was converted to '@' so that this page could be a comment in the alist source code.) Note the "default coordinate zero" which was inserted by hand. When these instructions are run through delila (using ex0bk as the library) and then given to alist with parameters alistp: -10 10 From and To pl display control p: piece&coordinate of zero base; l: long name n no paging i f: first base, i: inst, b: book alignment 6 4 1 avalues: column, output width, output decimals alistp: parameters for alist 5.54 and heigher An example list file is: alist 6.05, aligned listing of book: * 95/01/24 22:43:43, 95/01/24 19:36:00, 95/01/24 21:12:11 search 6.05 piece names from: * 95/01/24 22:43:43, 95/01/24 19:36:00, 95/01/24 21:12:11 search 6.05 The book is from: 0 to 20 This alignment is from: -30 to 20 --------------------- +++++++++++ 322222222221111111111--------- +++++++++11111111112 098765432109876543210987654321012345678901234567890 ................................................... lac 0 1 gtgaaaccagtaacgttatac lac 0 2 gtataacgttactggtttcac lac 0 3 gtataacgttactggtttcac documentation delman.use.aligned.books see also {program that produces the book: } delila.p {search program to help locate sites:} search.p {example inst:} spliceA.in {example book:} spliceA.bk {example aligned listing parameter file:} alistp {example colors file:} colors {To learn about page printer boundaries, go to} http://www.lecb.ncifcrf.gov/~toms/postscript.html#tricks author Thomas D. Schneider bugs If you use relative instructions, then alist will bomb. Ie, do not use instructions of the form: get from gene beginning - 5 to gene beginning +5; There is also an unsolved bug in alist: When the pieces and instructions are not 'just right', alist will produce listings that are thousands of characters wide... The reason for this is not completely clear, but it is related to attempting to extend the from-to range of an aligned book, and perhaps to incorrect responses of delila when attempting to 'reduce' a piece beginning or ending that is off the end of a fragment of a circular piece. The code now contains traps that halt the program when wide listings would have been generated. This bug may have been solved. Alist cannot align a sequence if the alignment point is outside the sequence. Note: it is possible to use the 'i' mode when "default coordinate zero" has been set, but this can lead to confusing output. There is no simple mechanism to prevent this in DelilaI. [1995 Dec 7] The namebook mechanism is currently broken for the clist. technical notes The variable 'nametype' defines the kind of name picked up in namebook. The constant 'pagelength' defines the length of the page in the list. The constant 'topofpage' defines the top of the page in cm in the clist. There are 4 constants that tell the program the printer page boundaries: The following bounding box is for the Canon Color Laser Copier 1150. defaultllx = 7.10999; default for llx, lower left x defaultlly = 7.01995; default for lly, lower left y defaulturx = 588.15; default for urx, upper right x defaultury = 784.98; default for ury, upper right y These should be set for your printer. To see how this is done, go to the link given in the See Also. Alternatively, you can use the edgecontrol parameter. As of version 5.96, alist can sense that a parameter file (alistp) is out of date and it will automatically upgrade the file. For this reason the parameter file is now listed as 'inout', meaning that it can be modified by this program. */ /* end module describe.alist */ /* begin module alist.const */ /* more constants */ #define pagelength 59 /* the length of pages for the list, in lines */ #define headerlines 10 /* the number of lines used by list first page header */ #define headerclines 5 /* the number of lines used by clist page header */ #define maxnumberwidth 7 /* the width of numbers in the list and clist */ #define columnmax 20 /* maximum column name in characters */ /* bounding box definitions: */ /* The following bounding box is for the Canon Color Laser Copier 1150. */ #define defaultllx 7.10999 /* default for llx, lower left x */ #define defaultlly 7.01995 /* default for lly, lower left y */ #define defaulturx 588.15 /* default for urx, upper right x */ #define defaultury 784.98 /* default for ury, upper right y */ /* (* The following bounding box is for the Canon Color Laser Copier 800S. *) defaultllx = 10.08; (* default for llx, lower left x *) defaultlly = 8.91; (* default for lly, lower left y *) defaulturx = 588.06; (* default for urx, upper right x *) defaultury = 779.85; (* default for ury, upper right y *) */ /* (* the following bounding box is for the Tektronix Inkjet Phaser 140 *) defaultllx = 14.4; (* default for llx, lower left x *) defaultlly = 28.9; (* default for lly, lower left y *) defaulturx = 596.8; (* default for urx, upper right x *) defaultury = 777.7; (* default for ury, upper right y *) */ /* constants to control the edges */ #define deffontsize 15 /* font size (height) in points (1/72 inch) */ #define defcolorlistcontrol 'C' /* normal display */ #define defcharacterratio 0.60 /* default for the ratio of the rightward horizontal motion when a character is drawn to the font height. See lister.p for source and more information about this. */ #define topofpage 27.0 /* top of page in cm */ #define defdeltaXcm 1.0 /* default X shift in cm */ #define defdeltaYcm (-1.0) /* default Y shift in cm */ #define defscaleimage 1.0 /* default scale of image */ /* end module alist.const */ /* LOCK begin module book.const */ /* constants needed for book manipulations */ #define dnamax 300 /* length of dna arrays */ #define namelength 100 /* maximum key name length */ #define linelength 80 /* maximum line readable in book */ /* LOCK end module book.const version = 'delmod 6.88 98 Jul 10 tds/gds' */ /* PostScript constants */ #define pwid 8 /* width in character places to print PostScript numbers */ #define pdec 5 /* decimal places to print PostScript numbers */ #define pdecolor 4 /* decimal places for color descriptions (5 WILL CAUSE NeWS 1.1 TO BOMB) */ /* begin module interact.const */ /* begin module string.const */ #define maxstring 2000 /* the maximum string */ /* end module string.const version = 4.86; (@ of prgmod.p 2004 Sep 8 */ /* end module interact.const version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module filler.const */ #define fillermax 50 /* the size of the filler array for a string */ /* end module filler.const version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* begin module interact.type */ /* begin module string.type */ /* pointer to a string */ typedef struct string { /* a string of characters */ Char letters[maxstring]; /* the letters in the string */ long length; /* the number of characters in the string */ long current; /* the letter we are working on */ Char *next; /* the next string in a series */ } string; /* end module string.type version = 4.86; (@ of prgmod.p 2004 Sep 8 */ /* end module interact.type version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module filler.type */ /* the following is an array used to fill a string. it is convenient to have it much shorter than the maxstring, so that it is easy to fill the string using procedure fillstring. the user must declare the value of constant fillermax. */ typedef Char filler[fillermax]; /* end module filler.type version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* begin module trigger.type */ typedef struct trigger { /* an object to be searched for */ string seek; /* the characters looked for */ long state; /* how close to triggering we are */ boolean skip; /* trigger not found- skip the line */ /* the trigger was found */ boolean found; } trigger; /* end module trigger.type version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* begin module book.type */ /* types needed for book manipulations */ typedef long chset[5]; /* types defined in book definition */ typedef Char alpha[namelength]; /* this is not alfa */ /* name is a left justified string with blanks following the characters */ typedef struct name { alpha letters; /* zero means an unspecified structure */ char length; } name; typedef struct line { /* a line of characters */ Char letters[linelength]; char length; struct line *next; } line; typedef enum { plus, minus, dircomplement, dirhomologous } direction; typedef enum { linear, circular } configuration; typedef enum { on, off } state; typedef struct header { /* header of key */ name keynam; /* key name of structure */ line *fulnam; /* full name of structure */ /* note key */ line *note; } header; /* begin module base.type */ /* define the four nucleotide bases */ typedef enum { a, c, g, t } base; /* end module base.type version = 7.72; {of delmod.p 2007 Jul 23} */ /* sequence types */ typedef short dnarange; /* p2c: alist.p, line 555: * Note: Field width for seq assumes enum base has 4 elements [105] */ typedef uchar seq[(dnamax + 3) / 4]; typedef struct dnastring { seq part; dnarange length; struct dnastring *next; } dnastring; typedef struct orgkey { /* organism key */ header hea; /* genetic map units */ line *mapunit; } orgkey; typedef struct chrkey { /* chromosome key */ header hea; double mapbeg; /* number of genetic map beginning */ /* number of genetic map ending */ double mapend; } chrkey; typedef struct piekey { /* piece key */ header hea; double mapbeg; /* genetic map beginning */ configuration coocon; /* configruation (circular/linear) */ direction coodir; /* direction (+/-) relative to genetic map */ long coobeg; /* beginning nucleotide */ long cooend; /* ending nucleotide */ configuration piecon; /* configruation (circular/linear) */ direction piedir; /* direction (+/-) relative to coordinates */ long piebeg; /* beginning nucleotide */ long pieend; /* ending nucleotide */ } piekey; typedef struct piece { piekey key; dnastring *dna; } piece; typedef struct reference { name pienam; /* name of piece referred to */ double mapbeg; /* genetic map beginning */ direction refdir; /* direction relative to coordinates */ long refbeg; /* beginning nucleotide */ long refend; /* ending nucleotide */ } reference; typedef struct genkey { /* gene key */ header hea; reference ref; } genkey; typedef struct trakey { /* transcript key */ header hea; reference ref; } trakey; typedef struct markey { /* marker key */ header hea; reference ref; state sta; line *phenotype; struct marker *next; } markey; typedef struct marker { markey key; dnastring *dna; } marker; /* end module book.type version = 7.72; {of delmod.p 2007 Jul 23} */ Static _TEXT inst; /* the delila instructions required by the align procedures */ Static _TEXT book; /* the book to be aligned */ Static _TEXT alistp; /* parameters to constrol the program */ Static _TEXT namebook; /* a book from which to draw names of pieces listed */ Static _TEXT namelist; /* a list of names */ Static _TEXT avalues; /* values to list */ Static _TEXT list; /* the resulting aligned listing */ Static _TEXT clist; /* the resulting aligned listing, in color PostScript */ Static _TEXT colors; /* colors PostScript */ /* variables used by the align routines: */ Static piece *apiece; Static long length_, alignedbase, fromparam, toparam; Static long fromdo, todo; /* user defined range to use */ Static boolean userrange; /* if true, the user defined range is used */ Static Char displaylevel; /* defines how much information to put on the display 'p' means put piece name and zero coordinate */ Static Char usefullname; /* defines whether to use the long name from the book 'l' means use it */ Static long fullnamewidth; /* length of the longest fullname in the book */ Static Char paging; /* defines whether to do pages. If 'n' no pages are done */ Static long index_; /* aligned space index */ Static long indexfill; /* index for filling out the namelist */ Static long cpagelength; /* the length of pages for the clist, in lines. This used to be hardwired to 47, but now is computed from the bounding box information defaultlly and defaultury in startpostscript. */ Static long linenumber; /* line of the page we are on */ Static long clinenumber; /* line of the page we are on in color */ /* headerlinenumber: integer; (* header length for list *) this is not used */ /* the number of lines used by the first page header of clist: */ Static long headerclinenumber; Static long pagenumber; /* the page number */ Static long cpagenumber; /* the page number */ /* used by procedures maxname and printname for getocp */ Static orgkey org; Static boolean orgchange, orgopen; Static chrkey chr; Static boolean chrchange, chropen; Static piece *pie; Static boolean piechange, pieopen; Static Char nametype; /* the type of name to look for in namebook. it can be 'g', 't', or 'p'. */ Static long namewidth; /* the amount of space to allocate to names */ Static long namelistwidth; /* space to allocate for names in namelist */ Static long numberwidth; /* the width of numbers in the list and clist */ Static long positionwidth; /* the width of position numbers */ Static long sequences; /* the number of sequences in the book */ Static Char b; /* a base to print out */ Static long column; /* counts the column of the printout so that color PostScript won't have really huge lines */ Static Char alignmenttype; /* 'f' means alignment by First internal coordinate base, 'b' means alignment by Book, 'i' means alignment by Instructions */ Static Char cnamelist; /* a character for reading and writing namelist */ Static name programname; /* the name of this program */ Static Char thedirection; /* the direction of the piece to report */ Static boolean readvalues; /* whether to read values from file avalues */ Static Char columnname[columnmax]; /* column name */ Static long columnlength; /* current length of the columnname */ Static long columntoread; /* the column to read from avalues */ Static long columnwid; /* the character width of the avalues column to write */ Static long columndec; /* the decimal places of the avalues column to write */ Static double columnvalue; /* a value from the column of avalues */ Static long theline; /* current line in the book */ Static double parameterversion; /* parameter version number */ /* variables to control the postscript display */ Static double llx; /* lower left x */ Static double lly; /* lower left y */ Static double urx; /* upper left x */ Static double ury; /* upper left y */ Static Char edgecontrol; /* if 'p' then use page instead of edges */ Static double edgeleft, edgeright, edgelow, edgehigh; /* edges around the clist */ Static long blanks; /* the number of blanks before the numbar */ Static long displaywidth; /* total width of display in characters */ Static double cmfactor; /* convert from cm to points */ /* not used: fontsizecm: real; (* font size in cm *) */ Static long fontsize; /* font size in points (1/72 inch) */ Static Char colorlistcontrol; /* control map production */ Static boolean mapcontrol; /* true if colorlistcontrol = 'C' or 'R' */ Static double deltaXcm; /* amount to move the entire page in X */ Static double deltaYcm; /* amount to move the entire page in Y */ Static double scaleimage; /* amount to scale the entire page from upper left corner */ Static Char headercontrol; /* control the header, 'h' means produce the header */ /* begin module book.var */ /* ************************************************************************ */ /* global variables needed for book manipulations */ /* free storage: */ Static line *freeline; /* unused lines */ Static dnastring *freedna; /* unused dnas */ Static boolean readnumber; /* whether to read a number from the notes, or to read in the notes */ Static long number; /* the number of the item just read */ Static boolean numbered; /* true when the item just read is numbered */ Static boolean skipunnum; /* a control variable to allow skipping of un-numbered items in the book */ /* ************************************************************************ */ /* end module book.var version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module crash */ Static Void crash() { /* Crash the program by trying to open a nonexistant file. This allows tracing by the dbx program. To use: insert call into the halt program or whereever a traceable stop is desired. */ _TEXT bogus; /* boghous internal file */ bogus.f = NULL; *bogus.name = '\0'; printf(" program crash.\n"); if (*bogus.name != '\0') bogus.f = fopen(bogus.name, "r"); else rewind(bogus.f); if (bogus.f == NULL) _EscIO2(FileNotFound, bogus.name); RESETBUF(bogus.f, Char); fclose(bogus.f); } Static jmp_buf _JL1; /* end module crash version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module halt */ Static Void halt() { /* stop the program. the procedure performs a goto to the end of the program. you must have a label: label 1; declared, and also the end of the program must have this label: 1: end. examples are in the module libraries. this is the only goto in the delila system. */ printf(" program halt.\n"); longjmp(_JL1, 1); } /* end module halt version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module copyaline */ Static Void copyaline(fin, fout) _TEXT *fin, *fout; { /* copy a line from file fin to file fout */ while (!P_eoln(fin->f)) { putc(P_peek(fin->f), fout->f); getc(fin->f); } fscanf(fin->f, "%*[^\n]"); getc(fin->f); putc('\n', fout->f); } /* copyaline */ /* end module copyaline version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module copynoreturn */ Static Void copynoreturn(fin, fout) _TEXT *fin, *fout; { /* copy a line from file fin to file fout but don't put a carriage return */ while (!P_eoln(fin->f)) { putc(P_peek(fin->f), fout->f); getc(fin->f); } fscanf(fin->f, "%*[^\n]"); getc(fin->f); /* writeln(fout); */ } /* copynoreturn */ /* end module copynoreturn */ /* begin module copytocomma */ Static Void copytocomma(fin, fout) _TEXT *fin, *fout; { /* copynoreturn */ /* copy a line from file fin to file fout only up to a comma and don't put a carriage return if found */ boolean done = false; /* done copying */ while (!done) { if (P_eoln(fin->f)) { done = true; fscanf(fin->f, "%*[^\n]"); getc(fin->f); } else { if (P_peek(fin->f) == ',') done = true; putc(P_peek(fin->f), fout->f); getc(fin->f); } } } /* copytocomma */ /* end module copytocomma */ /* begin module splitbooktitle */ Static Void splitbooktitle(book, list) _TEXT *book, *list; { /* copy the title of the book to the list, but split the title line up: * 2000/06/21 00:40:04, 1999/05/11 16:29:30, OxyR version = 2.12 of inst.oxyr 2000 June 21 */ if (*book->name != '\0') { if (book->f != NULL) book->f = freopen(book->name, "r", book->f); else book->f = fopen(book->name, "r"); } else rewind(book->f); if (book->f == NULL) _EscIO2(FileNotFound, book->name); RESETBUF(book->f, Char); copytocomma(book, list); copytocomma(book, list); fprintf(list->f, "\n "); copyaline(book, list); } /* end module splitbooktitle */ /******************************************************************************/ /******************************************************************************/ /******************************************************************************/ /* begin module package.trigger */ /* ************************************************************************ */ /* begin module clearstring */ /* These modules clear strings in various ways */ /* ---- */ Static Void emptystring(ribbon) string *ribbon; { /* clearstring */ /* empty the contents of the string but do NOT remove the pointer. This is useful for clearing one string within a linked list of them. */ long index; /* to the ribbon */ for (index = 0; index < maxstring; index++) ribbon->letters[index] = ' '; ribbon->length = 0; ribbon->current = 0; } /* emptystring */ /* ---- */ Static Void clearstring(ribbon) string *ribbon; { /* empty the string and remove the pointer */ emptystring(ribbon); ribbon->next = NULL; } /* clearstring */ /* ---- */ Static Void initializestring(ribbon) string *ribbon; { /* start the string with a nil pointer. This routine should be called before doing linked list work. This allows the standard string routines to clear the string without killing the pointer. This is now deprecated, do not use it since clearstring still clears the next pointer. */ printf("remove initializestring routine!\n"); printf("replace it with clearstring routine!\n"); halt(); /* to force deprecation */ clearstring(ribbon); ribbon->next = NULL; } /* initializestring */ /* end module clearstring version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* begin module writestring */ Static Void writestring(tofile, s) _TEXT *tofile; string *s; { /* write the string s to file tofile, no writeln */ long i; /* index to s */ long FORLIM; FORLIM = s->length; for (i = 0; i < FORLIM; i++) putc(s->letters[i], tofile->f); } /* writestring */ /* end module writestring version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* begin module filler.fillstring */ Static Void fillstring(s, a_) string *s; Char *a_; { /* this procedure makes it reasonably easy to fill the string s with characters. one calls the procedure as: */ /* 1 2 3 4 5 */ /* 12345678901234567890123456789012345678901234567890 */ /* fillstring(s, 'this-is-the-string '); the two comments make it easy to line the characters up. also, for this example, it was assumed that the length of filler as defined by the constant fillermax was 50. */ long length = fillermax; /* of the string without trailing blanks */ long index; /* of s */ clearstring(s); while (length > 1 && a_[length-1] == ' ') length--; if (length == 1 && a_[length-1] == ' ') { printf("fillstring: the string is empty\n"); halt(); } for (index = 0; index < length; index++) s->letters[index] = a_[index]; s->length = length; s->current = 1; } /* fillstring */ /* end module filler.fillstring version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* begin module filler.filltrigger */ Static Void filltrigger(t_, a_) trigger *t_; Char *a_; { /* fill the trigger t */ fillstring(&t_->seek, a_); } /* fillstring */ /* end module filler.filltrigger version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* begin module trigger.proc */ /* this module allows one to scan a series of characters, as from an array or a file, and to "trigger" or detect a simple string in the series. the advantage of the trigger is that several triggers can "observe" a stream of characters at once, each looking for a different thing. some other modules required: interact.const, interact.type */ Static Void resettrigger(t_) trigger *t_; { /* reset the trigger to ground state */ t_->state = 0; t_->skip = false; t_->found = false; } /* resettrigger */ Static Void testfortrigger(ch, t_) Char ch; trigger *t_; { /* look at the character ch. if it is part of the trigger (at the current trigger state), then the trigger state goes higher. if it is not part of the trigger then the trigger state is reset, skip is true and one should skip onward to find the trigger. if the trigger is found, found is true. 1996 Sep 12: Bug found! In the case of a trigger "ab", the program used to miss it for situations like "aab". This was because at the first a it would step up. Then it would see the second a and recognize that was not part of ab. It would fail to realize that it could be the start of a new one. The code now accounts for that possibility. */ t_->state++; /* writestring(list,seek); writeln(list,'testfortrigger seek.letters[',state:1,']:', seek.letters[state],' ch:',ch); */ if (t_->seek.letters[t_->state - 1] == ch) { t_->skip = false; if (t_->state == t_->seek.length) t_->found = true; else t_->found = false; return; } /* it failed. But wait! It could be the beginning of a NEW trigger string! */ if (t_->seek.letters[0] == ch) { t_->state = 1; t_->skip = false; t_->found = false; return; } t_->state = 0; t_->skip = true; t_->found = false; /* reset trigger */ } /* testfortrigger */ #define tab 9 /* tab character */ /* end module trigger.proc version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* begin module skipblanks */ /* 2003 July 31: tab is considered a blank character */ Static boolean isblank(c_) Char c_; { /* is the character c blank or tab? */ return (c_ == ' ' || c_ == tab); } #undef tab Static Void skipblanks(thefile) _TEXT *thefile; { /* skip over blanks until a non-blank, or end of line, is found */ while (isblank(P_peek(thefile->f)) & (!P_eoln(thefile->f))) getc(thefile->f); } Static Void skipnonblanks(thefile) _TEXT *thefile; { /* skip over nonblanks until a blank, or end of line, is found */ while ((!isblank(P_peek(thefile->f))) & (!P_eoln(thefile->f))) getc(thefile->f); } Static Void skipcolumn(thefile) _TEXT *thefile; { /* skip over a data column */ skipblanks(thefile); skipnonblanks(thefile); } /* end module skipblanks version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* ************************************************************************ */ /* end module package.trigger version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /******************************************************************************/ /******************************************************************************/ /******************************************************************************/ /* begin module package.align */ /* ************************************************************************ */ /* begin module package.getpiece */ /* ************************************************************************ */ /* begin module package.brpiece */ /* ************************************************************************ */ /* begin module book.basis */ /* procedures needed for book manipulations */ /* get procedures should be used for all linked lists of records */ Static Void getline(l) line **l; { /* obtain a line from the free line list or by making a new one */ if (freeline != NULL) { *l = freeline; freeline = freeline->next; } else *l = (line *)Malloc(sizeof(line)); (*l)->length = 0; (*l)->next = NULL; } Static Void getdna(l) dnastring **l; { if (freedna != NULL) { *l = freedna; freedna = freedna->next; } else *l = (dnastring *)Malloc(sizeof(dnastring)); (*l)->length = 0; (*l)->next = NULL; } /* clear procedures should be called each time the records are no longer needed failure to do this may result in a stack overflow. */ Static Void clearline(l) line **l; { /* return a line to the free line list */ line *lptr; if (*l == NULL) return; lptr = *l; *l = (*l)->next; lptr->next = freeline; freeline = lptr; } Static Void writeline(afile, l, carriagereturn) _TEXT *afile; line *l; boolean carriagereturn; { /* write a line to a file, with carriage return if carriagereturn is true. */ long index; /* index to characters in l */ long FORLIM; FORLIM = l->length; for (index = 0; index < FORLIM; index++) putc(l->letters[index], afile->f); if (carriagereturn) putc('\n', afile->f); } Static Void showfreedna() { /* show the freedna list */ long counter = 0; /* count of freedna list */ dnastring *l; /* pointer into freedna list */ l = freedna; while (l != NULL) { counter++; printf("%ld", counter); printf(", length = %d\n", l->length); /* This is illegal according to gpc because one cannot write a pointer to a text file. It can be unearthed for debugging. write(output, ', pointer id: ',l:1); */ l = l->next; } } Static Void cleardna(l) dnastring **l; { /* clear the dna strutures to the free list */ dnastring *lptr; if (*l == NULL) return; lptr = *l; *l = (*l)->next; lptr->next = freedna; freedna = lptr; } Static Void clearheader(h) header *h; { /* clear the header h (remove lines to free storage) */ clearline(&h->fulnam); while (h->note != NULL) clearline(&h->note); } Static Void clearpiece(p) piece **p; { /* clear the dna of the piece */ while ((*p)->dna != NULL) cleardna(&(*p)->dna); clearheader(&(*p)->key.hea); } Static base chartobase(ch) Char ch; { /* convert a character into a base */ base Result; switch (ch) { case 'a': Result = a; break; case 'c': Result = c; break; case 'g': Result = g; break; case 't': Result = t; break; } return Result; } Static Char basetochar(ba) base ba; { /* convert a base into a character */ Char Result; switch (ba) { case a: Result = 'a'; break; case c: Result = 'c'; break; case g: Result = 'g'; break; case t: Result = 't'; break; } return Result; } Static base complement(ba) base ba; { /* take the complement of ba */ base Result; switch (ba) { case a: Result = t; break; case c: Result = g; break; case g: Result = c; break; case t: Result = a; break; } return Result; } Static Char chomplement(b) Char b; { /* create the character complement of base b. I must be getting hungry! */ return (basetochar(complement(chartobase(b)))); } Static long pietoint(p, pie) long p; piece *pie; { /* p is a coordinate on the piece. we want to transform p into a number from 1 to n: an internal coordinate system for easy manipulation of piece coordinates */ /* Note: the dirhomologous and dircomplement are treated as plus and minus directions, which MIGHT NOT BE RIGHT! */ long i; /* an intermediate value */ piekey *WITH; WITH = &pie->key; switch (WITH->piedir) { case dirhomologous: case plus: if (p >= WITH->piebeg) i = p - WITH->piebeg + 1; else i = p - WITH->coobeg + WITH->cooend - WITH->piebeg + 2; break; case dircomplement: case minus: if (p <= WITH->piebeg) i = WITH->piebeg - p + 1; else i = WITH->cooend - p + WITH->piebeg - WITH->coobeg + 2; break; } return i; } Static long inttopie(i, pie) long i; piece *pie; { /* i is in the range 1 to some maximum. it is an internal coordinate system for the program. we want to do a coordinate transformation to obtain a value in the range of the piece called pie: i=1 corresponds to piebeg and i=its maximum corresponds to pieend */ /* Note: the dirhomologous and dircomplement are treated as plus and minus directions, which MIGHT NOT BE RIGHT! */ long p; /* an intermediate value */ piekey *WITH; WITH = &pie->key; switch (WITH->piedir) { case dirhomologous: case plus: p = WITH->piebeg + i - 1; if (p > WITH->cooend) { if (WITH->coocon == circular) p += WITH->coobeg - WITH->cooend - 1; } break; case dircomplement: case minus: p = WITH->piebeg - i + 1; if (p < WITH->coobeg) { if (WITH->coocon == circular) p += WITH->cooend - WITH->coobeg + 1; } break; } return p; } Static long piecelength(pie) piece *pie; { /* return the length of the dna in pie */ return (pietoint(pie->key.pieend, pie)); } /* end module book.basis version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module book.getto */ Static Char getto(thefile, theline, ch) _TEXT *thefile; long *theline; long *ch; { /* search the file for a character in the first line which is a member of the set ch. Note: on 1999 March 10 the definition of this function was cleaned up. Instead of putting thefile on the line AFTER the charcter ch has been found, it puts thefile ON the line. Other routines like brdna and brpiece have to move to the next line themselves. This makes getto give the OBJECT. */ Char achar = ' '; /* a character in thefile */ boolean done = false; /* done finding achar */ while (!done) { if (BUFEOF(thefile->f)) { done = true; break; } achar = P_peek(thefile->f); if (P_inset(achar, ch)) { done = true; break; } fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; } if (P_inset(achar, ch)) return achar; else { return ' '; /* The old method - while (not(achar in ch)) and (not eof(thefile)) do begin readln(thefile,achar); theline := succ(theline) end; if (achar in ch) then getto:=achar else getto:=' ' */ } } /* end module book.getto version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module book.skipstar */ Static Void skipstar(thefile) _TEXT *thefile; { /* skip start of line (or star = '*'). */ if (BUFEOF(thefile->f)) { printf(" procedure skipstar: end of book found\n"); halt(); return; } if (P_peek(thefile->f) != '*') { printf(" procedure skipstar: bad book\n"); printf(" \"*\" expected as first character on the line, but \"%c\" was found\n", P_peek(thefile->f)); halt(); } getc(thefile->f); /* skip the star */ if (P_peek(thefile->f) != ' ') { /* skip the blank */ printf(" procedure skipstar: bad book\n"); printf(" \"* \" expected on a line but \"*%c\" was found\n", P_peek(thefile->f)); halt(); } getc(thefile->f); } /* skipstar */ /* end module book.skipstar version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module book.brreanum */ Static Void brreanum(thefile, theline, reanum) _TEXT *thefile; long *theline; double *reanum; { /* read a real number from the file */ skipstar(thefile); fscanf(thefile->f, "%lg%*[^\n]", reanum); getc(thefile->f); (*theline)++; } /* end module book.brreanum version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module book.brnumber */ Static Void brnumber(thefile, theline, num) _TEXT *thefile; long *theline, *num; { /* read a number from the file */ skipstar(thefile); fscanf(thefile->f, "%ld%*[^\n]", num); getc(thefile->f); (*theline)++; } /* end module book.brnumber version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module book.brname */ Static Void brname(thefile, theline, nam) _TEXT *thefile; long *theline; name *nam; { /* read a name from the file */ long i; /* an index to the name */ Char c_; /* a character read */ skipstar(thefile); nam->length = 0; do { nam->length++; c_ = getc(thefile->f); if (c_ == '\n') c_ = ' '; nam->letters[nam->length - 1] = c_; } while (!(P_eoln(thefile->f) || nam->length >= namelength || nam->letters[nam->length - 1] == ' ')); if (nam->letters[nam->length - 1] == ' ') nam->length--; if (nam->length < namelength) { for (i = nam->length; i < namelength; i++) nam->letters[i] = ' '; } fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; } /* brname */ /* end module book.brname version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module book.brline */ Static Void brline(thefile, theline, l) _TEXT *thefile; long *theline; line **l; { /* read a line from the file */ long i = 0; Char acharacter; skipstar(thefile); /* protection added 2005 Sep 15 */ while (!P_eoln(thefile->f) && i < linelength) { i++; acharacter = getc(thefile->f); if (acharacter == '\n') acharacter = ' '; (*l)->letters[i-1] = acharacter; } /* protection added 2005 Sep 15 */ if (!P_eoln(thefile->f)) { printf("***********************************************\n"); printf("* WARNING: brline: book line length exceeded\n"); printf("* linelength > %ld characters\n", (long)linelength); printf("* Only %ld characters read from book\n", (long)linelength); printf("***********************************************\n"); } (*l)->length = i; (*l)->next = NULL; fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; } /* end module book.brline version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module book.brdirect */ Static Void brdirect(thefile, theline, direct) _TEXT *thefile; long *theline; direction *direct; { /* read a direction */ Char ch; skipstar(thefile); fscanf(thefile->f, "%c%*[^\n]", &ch); getc(thefile->f); if (ch == '\n') ch = ' '; (*theline)++; if (ch == '+') *direct = plus; else *direct = minus; } /* end module book.brdirect version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module book.brconfig */ Static Void brconfig(thefile, theline, config) _TEXT *thefile; long *theline; configuration *config; { /* read a configuration */ Char ch; skipstar(thefile); fscanf(thefile->f, "%c%*[^\n]", &ch); getc(thefile->f); if (ch == '\n') ch = ' '; (*theline)++; if (ch == 'l') *config = linear; else *config = circular; } /* end module book.brconfig version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module book.brnotenumber */ Static Void brnotenumber(thefile, theline, note) _TEXT *thefile; long *theline; line **note; { /* book note reading to obtain the number of the object. the procedure returns the value of the number as a global. (this is not such a good practice, but we are stuck with it for now.) */ *note = NULL; numbered = false; number = 0; /* force number to zero if there is no number at all */ /* the next character is n or * depending on whether there are notes */ if (P_peek(thefile->f) != 'n') return; fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; if (P_peek(thefile->f) != 'n') { skipstar(thefile); if (!P_eoln(thefile->f)) { if (P_peek(thefile->f) == '#') { numbered = true; getc(thefile->f); /* move past the number symbol */ fscanf(thefile->f, "%ld", &number); } } do { fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; } while (P_peek(thefile->f) != 'n'); fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; return; } fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; } /* brnotenumber */ /* end module book.brnotenumber version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module book.brnote */ Static Void brnote(thefile, theline, note) _TEXT *thefile; long *theline; line **note; { /* read note key */ line *newnote; /* the new note */ line *previousnote; /* the last line of the notes */ *note = NULL; if (P_peek(thefile->f) != 'n') /* enter note */ return; fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; if (P_peek(thefile->f) != 'n') { /* abort null note (n/n) */ getline(note); newnote = *note; while (P_peek(thefile->f) != 'n') { /* wait until end of note */ brline(thefile, theline, &newnote); previousnote = newnote; /* get next note */ getline(&newnote->next); newnote = newnote->next; } /* last note was not used, so: */ clearline(&newnote); previousnote->next = NULL; fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; return; } fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; } /* brnote */ /* end module book.brnote version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module book.brheader */ Static Void brheader(thefile, theline, hea) _TEXT *thefile; long *theline; header *hea; { /* read the header of a key. */ fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); /* move past the object name - new definition 1999 Mar 13 */ (*theline)++; /*bbb*/ /* read key name */ brname(thefile, theline, &hea->keynam); /* read full name */ getline(&hea->fulnam); brline(thefile, theline, &hea->fulnam); /* read note key */ if (readnumber) brnotenumber(thefile, theline, &hea->note); else brnote(thefile, theline, &hea->note); } /* end module book.brheader version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module book.copyheader */ Static Void copyheader(fromhea, tohea) header fromhea, *tohea; { /* copy the header fromhea into tohea. Note that the linked objects are NOT copied, but merely pointed to. */ memcpy(tohea->keynam.letters, fromhea.keynam.letters, sizeof(alpha)); tohea->keynam.length = fromhea.keynam.length; tohea->note = fromhea.note; tohea->fulnam = fromhea.fulnam; } /* end module book.copyheader version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module book.brpiekey */ Static Void brpiekey(thefile, theline, pie) _TEXT *thefile; long *theline; piekey *pie; { /* read piece key, track the line number */ brheader(thefile, theline, &pie->hea); brreanum(thefile, theline, &pie->mapbeg); brconfig(thefile, theline, &pie->coocon); brdirect(thefile, theline, &pie->coodir); brnumber(thefile, theline, &pie->coobeg); brnumber(thefile, theline, &pie->cooend); brconfig(thefile, theline, &pie->piecon); brdirect(thefile, theline, &pie->piedir); brnumber(thefile, theline, &pie->piebeg); brnumber(thefile, theline, &pie->pieend); } /* end module book.brpiekey version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module book.brdna */ Static Void brdna(thefile, theline, dna) _TEXT *thefile; long *theline; dnastring **dna; { /* read in dna from thefile, track the line */ /* note: if the dna were circularized, by linking the last dnastring to the first, then the cleardna routine could not clear properly, and would loop forever... there is no reason to do that, since a simple mod function will allow one to access the circle. */ Char ch; dnastring *workdna; long SET[5]; long TEMP; getdna(dna); workdna = *dna; ch = getto(thefile, theline, P_addset(P_expset(SET, 0L), 'd')); fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; ch = getc(thefile->f); /* skipstar */ if (ch == '\n') ch = ' '; while (ch == '*') { ch = getc(thefile->f); /* skip blank */ if (ch == '\n') ch = ' '; do { ch = getc(thefile->f); if (ch == '\n') ch = ' '; if (ch == 't' || ch == 'g' || ch == 'c' || ch == 'a') { if (workdna->length == dnamax) { getdna(&workdna->next); workdna = workdna->next; } workdna->length++; TEMP = workdna->length - 1; P_clrbits_B(workdna->part, TEMP, 1, 3); P_putbits_UB(workdna->part, TEMP, (int)chartobase(ch), 1, 3); } } while (!P_eoln(thefile->f)); fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); /* go to next line */ (*theline)++; ch = getc(thefile->f); /* ch is either '*' or 'd' */ if (ch == '\n') ch = ' '; } fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); /* read past the d */ (*theline)++; } /* end module book.brdna version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module book.brpiece */ Static Void brpiece(thefile, theline, pie) _TEXT *thefile; long *theline; piece **pie; { /* read in a piece, change theline to reflect the lines traversed */ /* readln(thefile); (* move past the word 'piece' - new definition 1999 Mar 13 *) theline := succ(theline); (* BUG: was below! *) bbb*/ brpiekey(thefile, theline, &(*pie)->key); if (numbered || !skipunnum) brdna(thefile, theline, &(*pie)->dna); fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); /* move past the word 'piece' - new definition 1999 Mar 13 */ (*theline)++; } /* end module book.brpiece version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module book.brinit */ Static Void brinit(book, theline) _TEXT *book; long *theline; { /* check that the book is ok to read, and set up the global variables for br routines */ /* halt if the book is bad (first word is 'halt') or the first character is not * */ if (*book->name != '\0') { if (book->f != NULL) book->f = freopen(book->name, "r", book->f); else book->f = fopen(book->name, "r"); } else rewind(book->f); if (book->f == NULL) _EscIO2(FileNotFound, book->name); RESETBUF(book->f, Char); if (!BUFEOF(book->f)) { /* check for the date line */ if (P_peek(book->f) != '*') { if (P_peek(book->f) != 'h') printf(" this is not the first line of a book:\n"); else printf(" bad book:\n"); putchar(' '); while (!(P_eoln(book->f) | BUFEOF(book->f))) { putchar(P_peek(book->f)); getc(book->f); } putchar('\n'); halt(); } } else { printf(" book is empty\n"); halt(); } /* initialize free storage */ freeline = NULL; freedna = NULL; readnumber = true; /* usually we read in numbers for items */ number = 0; /* arbitrary value */ numbered = false; /* the piece has no number (none yet read in) */ skipunnum = false; *theline = 1; } /* brinit */ /* end module book.brinit version = 7.72; {of delmod.p 2007 Jul 23} */ /* ************************************************************************ */ /* end module package.brpiece version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module book.getpiece */ Static Void getpiece(thefile, theline, pie) _TEXT *thefile; long *theline; piece **pie; { /* move to and read in the next piece in the book */ Char ch; long SET[5]; ch = getto(thefile, theline, P_addset(P_expset(SET, 0L), 'p')); /* get to the next p(iece) in the book */ if (ch != ' ') { brpiece(thefile, theline, pie); /* 1999 june 2: removed this: ch:=getto(thefile,theline,['p']); (* read to end of p *) */ /* bbb - now done in brpiece readln(thefile); (* read past piece *) theline := succ(theline); */ } else clearpiece(pie); } /* end module book.getpiece version = 7.72; {of delmod.p 2007 Jul 23} */ /* ************************************************************************ */ /* end module package.getpiece version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module findblank */ Static Void findblank(afile) _TEXT *afile; { /* read a file to find the next blank character */ Char ch; do { ch = getc(afile->f); if (ch == '\n') ch = ' '; } while (ch != ' '); } /* end module findblank version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module findnonblank */ Static Void findnonblank(afile, ch) _TEXT *afile; Char *ch; { /* find the next non blank character in a file, return it in ch. */ *ch = ' '; while (!BUFEOF(afile->f) && *ch == ' ') { *ch = getc(afile->f); if (*ch == '\n') *ch = ' '; if (P_eoln(afile->f)) { fscanf(afile->f, "%*[^\n]"); getc(afile->f); } } } #define maximumrange 10000 /* if the alignment point is more than this distance from the piece ends, the program halts in an attempt to catch the alignment bug... 1991 Jan 11 It appears that the rewrite of the code has removed the bug, but the check will be kept. */ #define semicolon ';' /* end of delila instruction */ /* Local variables for align: */ struct LOC_align { _TEXT *inst; Char ch; /* a character in inst */ trigger endcomment; /* trigger to find '*-)' (ignore the dash!) */ trigger endcurly; /* trigger to find comments: '}' */ } ; /* a dot '.' has been found in the name - ignore the rest of the name - for comparisons with mutations. */ /* procedure rd(var f: text; var ch: char); (* read ch from f allowing inspection of the result *) begin read(f,ch); write(output,ch); write(list,ch); write(output,'<',ch,'>'); end; procedure rdln(var f: text); (* readln f allowing inspection of the result *) begin readln(f); writeln(output); writeln(list); end; */ Local Void skipcomment(f, LINK) _TEXT *f; struct LOC_align *LINK; { /* skip an entire comment */ boolean comment = true; /* true means we are inside a comment */ /* skip to end of comment */ resettrigger(&LINK->endcomment); while (comment) { if (BUFEOF(f->f)) { printf("A comment does not end!\n"); halt(); } if (P_eoln(f->f)) { fscanf(f->f, "%*[^\n]"); getc(f->f); continue; } /* rdln(f) */ LINK->ch = getc(f->f); if (LINK->ch == '\n') LINK->ch = ' '; testfortrigger(LINK->ch, &LINK->endcomment); if (LINK->endcomment.found) { comment = false; /*write(output,'<'); rd(f,ch); write(output,'>');*/ } } } Local Void skipcurly(f, LINK) _TEXT *f; struct LOC_align *LINK; { /* skip an entire comment made by {}*/ boolean comment = true; /* true means we are inside a comment */ /* skip to end of comment */ resettrigger(&LINK->endcurly); while (comment) { if (BUFEOF(f->f)) { printf("A comment does not end!\n"); halt(); } if (P_eoln(f->f)) { fscanf(f->f, "%*[^\n]"); getc(f->f); continue; } /* rdln(f) */ LINK->ch = getc(f->f); if (LINK->ch == '\n') LINK->ch = ' '; testfortrigger(LINK->ch, &LINK->endcurly); if (LINK->endcurly.found) { comment = false; /*write(output,'<'); rd(f,ch); write(output,'>');*/ } } } Local Void skipquote(quote, LINK) trigger quote; struct LOC_align *LINK; { /* skip an entire quote of either the ' or " persuasion */ Char kind; /* the kind of quote, ' or " */ kind = quote.seek.letters[0]; /*writeln(output,'skipquote ',kind);*/ do { findnonblank(LINK->inst, &LINK->ch); /* get to the quote */ } while (!((LINK->ch == kind) | BUFEOF(LINK->inst->f))); if (LINK->ch != kind) { printf("end of quote starting with %c not found\n", kind); halt(); } } /* end module findnonblank version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module align.align */ Static Void align(inst_, book, theline, pie, length, alignedbase) _TEXT *inst_, *book; long *theline; piece **pie; long *length, *alignedbase; { /* documentation on align is in module info.align and delman.use.aligned.books. 1996 Sep 12: The routine now uses the trigger functions found in prgmod. The bug in the oldalign routine (that it misses the end of comments that end in a series of asterisks) has been fixed. It now checks that the piece corresponds to the book. */ struct LOC_align V; long p; /* index to a piece name */ long p1; /* another index to a piece name */ boolean done = false; /* done finding an aligning get */ long thebase; /* the base read in */ boolean indefault = false; /* true when within a default statement. These can contain the word 'piece', which must be ignored. */ trigger gettrigger; /* trigger to find 'get' */ trigger defaulttrigger; /* trigger to find 'default' */ trigger nametrigger; /* trigger to find 'name' */ trigger piecetrigger; /* trigger to find 'piece' */ trigger settrigger; /* trigger to find 'set' */ trigger begincomment; /* trigger to find '(-*' (ignore the dash!) */ trigger begincurly; /* trigger to find comments: '{' */ trigger quote1trigger; /* trigger to find single quote ' */ trigger quote2trigger; /* trigger to find double quote " */ boolean dotteddone; name *WITH; V.inst = inst_; filltrigger(&defaulttrigger, "default "); filltrigger(&gettrigger, "get "); filltrigger(&nametrigger, "name "); filltrigger(&piecetrigger, "piece "); filltrigger(&settrigger, "set "); filltrigger(&begincomment, "(* "); filltrigger(&V.endcomment, "*) "); filltrigger(&begincurly, "{ "); filltrigger(&V.endcurly, "} "); filltrigger("e1trigger, "' "); filltrigger("e2trigger, "\" "); resettrigger(&defaulttrigger); resettrigger(&gettrigger); resettrigger(&nametrigger); resettrigger(&piecetrigger); resettrigger(&settrigger); resettrigger(&begincomment); resettrigger(&begincurly); resettrigger("e1trigger); resettrigger("e2trigger); if (BUFEOF(book->f)) /* if there is still more to the book ... */ return; getpiece(book, theline, pie); /* read in the piece */ if (BUFEOF(book->f)) /* if we found a piece ... */ return; *length = pietoint((*pie)->key.pieend, *pie); /* calculate piece length */ /* now find in inst the next occurance of 'get' */ while (!done) { if (BUFEOF(V.inst->f)) { /* no instructions? */ *alignedbase = 1; /* simply align by the first base */ done = true; break; } if (P_eoln(V.inst->f)) { fscanf(V.inst->f, "%*[^\n]"); getc(V.inst->f); continue; } /*then rdln(inst)*/ V.ch = getc(V.inst->f); if (V.ch == '\n') V.ch = ' '; testfortrigger(V.ch, &begincomment); testfortrigger(V.ch, &begincurly); if (begincomment.found || begincurly.found) { if (V.ch == '*') { skipcomment(V.inst, &V); resettrigger(&begincomment); } else { resettrigger(&begincurly); skipcurly(V.inst, &V); } continue; } testfortrigger(V.ch, &gettrigger); if (gettrigger.found) { findnonblank(V.inst, &V.ch); /* get to "from" */ findblank(V.inst); /* get past "from" */ fscanf(V.inst->f, "%ld", &thebase); /* read in the alignedbase */ /*writeln(output);writeln(output,'thebase = ',thebase:1);*/ *alignedbase = pietoint(thebase, *pie); /*writeln(output,'alignedbase=',alignedbase:1);*/ done = true; } testfortrigger(V.ch, "e1trigger); if (quote1trigger.found) skipquote(quote1trigger, &V); testfortrigger(V.ch, "e2trigger); if (quote2trigger.found) skipquote(quote2trigger, &V); testfortrigger(V.ch, &defaulttrigger); if (defaulttrigger.found) { indefault = true; resettrigger(&defaulttrigger); } if (V.ch == semicolon) indefault = false; testfortrigger(V.ch, &settrigger); if (settrigger.found) { indefault = true; resettrigger(&settrigger); } if (V.ch == semicolon) indefault = false; /* check that piece names are correct */ testfortrigger(V.ch, &piecetrigger); if (indefault) continue; if (!piecetrigger.found) continue; skipblanks(V.inst); /* get to name */ WITH = &(*pie)->key.hea.keynam; /* for p := 1 to length do begin */ /* 2007 Jun 22: replace loop with while so that we can drop out when dotted names are detected. */ p = 1; dotteddone = false; while (!dotteddone) { if (P_eoln(V.inst->f)) { dotteddone = true; break; } V.ch = getc(V.inst->f); if (V.ch == '\n') V.ch = ' '; /* ignore names after a dot */ /* if ch = '.' then writeln(output,'inst dotteddone'); */ if (V.ch == '.') dotteddone = true; if (WITH->letters[p-1] == '.') dotteddone = true; /* if ch = '.' then writeln(output,'book dotteddone'); writeln(output,'BUBBa ch = ',ch,' ',p:1); */ /*zzz*/ if (WITH->letters[p-1] != V.ch && !dotteddone && V.ch != ';') { printf("The piece name in the book: \n"); /* p2c: alist.p, line 1968: Note: * Format for packed-array-of-char will work only if width < length [321] */ printf("%.*s\n", WITH->length, WITH->letters); printf("does not match the inst file piece name:\n"); /* write the letters that matched: */ for (p1 = 0; p1 <= p - 2; p1++) putchar(WITH->letters[p1]); /* write the offending letter: */ putchar(V.ch); /* get the rest of the name and show it: */ done = P_eoln(V.inst->f); while (!done) { done = P_eoln(V.inst->f); if (done) break; V.ch = getc(V.inst->f); if (V.ch == '\n') V.ch = ' '; if (V.ch == ' ' || V.ch == ';') done = true; if (!done) putchar(V.ch); } putchar('\n'); /* mark the first letter that does not match: */ for (p1 = 1; p1 < p; p1++) putchar(' '); printf("^\n"); halt(); } p++; if (p > WITH->length) { dotteddone = true; /* we are not inside a comment */ } } } /*rd(inst,ch);*/ if (*alignedbase > -maximumrange && *alignedbase <= *length + maximumrange) return; printf(" In procedure align:\n"); printf(" read in base was %ld\n", thebase); printf(" in internal coordinates: %ld\n", *alignedbase); printf(" maximum range was %ld\n", (long)maximumrange); printf(" piece length was %ld\n", *length); WITH = &(*pie)->key.hea.keynam; /* p2c: alist.p, line 2015: Note: * Format for packed-array-of-char will work only if width < length [321] */ printf(" piece name: %.*s\n", WITH->length, WITH->letters); printf(" piece number: %ld\n", number); printf(" aligned base is too far away... see the code\n"); halt(); } #undef maximumrange #undef semicolon #define maximumrange 500 /* end module align.align version = 7.72; {of delmod.p 2007 Jul 23} */ /* ************************************************************************ */ /* end module package.align version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module align.maxminalignment */ Static Void maxminalignment(inst, book, theline, fromparam, toparam, alignmenttype) _TEXT *inst, *book; long *theline, *fromparam, *toparam; Char alignmenttype; { /* prescan the book to find the range over which the pieces of the book are spread, relative to the aligned base. the procedure uses the same variables that align does (so it can call align itself), and it returns the range in fromparam and toparam. alignmenttype: 'f' means alignment by First internal coordinate base, 'b' means alignment by Book, 'i' means alignment by Instructions. */ /* the maximum size aligned piece; this will presumably catch the alignment bug */ long distance; /* a distance to the aligned base */ piece *pie; long length, alignedbase; pie = (piece *)Malloc(sizeof(piece)); /* set an initial range for the two bounds */ *fromparam = LONG_MAX; *toparam = -LONG_MAX; if (*book->name != '\0') { if (book->f != NULL) book->f = freopen(book->name, "r", book->f); else book->f = fopen(book->name, "r"); } else rewind(book->f); if (book->f == NULL) _EscIO2(FileNotFound, book->name); RESETBUF(book->f, Char); if (*inst->name != '\0') { if (inst->f != NULL) inst->f = freopen(inst->name, "r", inst->f); else inst->f = fopen(inst->name, "r"); } else rewind(inst->f); if (inst->f == NULL) _EscIO2(FileNotFound, inst->name); RESETBUF(inst->f, Char); while (!BUFEOF(book->f)) { switch (alignmenttype) { case 'i': align(inst, book, theline, &pie, &length, &alignedbase); break; case 'b': case 'f': getpiece(book, theline, &pie); /* read in the piece */ length = piecelength(pie); break; } if (BUFEOF(book->f)) break; switch (alignmenttype) { case 'f': /* force alignment on first base */ alignedbase = 0; *fromparam = 1; distance = length - alignedbase; if (*toparam < distance) *toparam = distance; break; case 'i': /* use the alignedbase from the book */ distance = 1 - alignedbase; if (*fromparam > distance) *fromparam = distance; distance = length - alignedbase; if (*toparam < distance) *toparam = distance; break; case 'b': /* use the internal book */ alignedbase = pietoint(0L, pie); distance = 1 - alignedbase; if (*fromparam > distance) *fromparam = distance; distance = length - alignedbase; if (*toparam < distance) *toparam = distance; break; } clearpiece(&pie); } if (*toparam - *fromparam > maximumrange) { printf(" in procedure maxminalignment:\n"); printf(" alignedbase = %ld\n", alignedbase); printf(" fromparameter = %ld\n", *fromparam); printf(" toparameter = %ld\n", *toparam); printf(" this exceeds the maximum range allowed (%ld)\n", (long)maximumrange); printf(" see notes in the procedure. \n"); /* notes: if you desired this range, increase 'maximumrange'. otherwise, this may indicate a bug - either: 1) locate the bug (and tell tom schneider, please...) 2) reduce the size of the fragments, from one or the other end until the bombing is stopped. */ halt(); } /* make the book readable again */ if (*book->name != '\0') { if (book->f != NULL) book->f = freopen(book->name, "r", book->f); else book->f = fopen(book->name, "r"); } else rewind(book->f); if (book->f == NULL) _EscIO2(FileNotFound, book->name); RESETBUF(book->f, Char); if (*inst->name != '\0') { if (inst->f != NULL) inst->f = freopen(inst->name, "r", inst->f); else inst->f = fopen(inst->name, "r"); } else rewind(inst->f); if (inst->f == NULL) _EscIO2(FileNotFound, inst->name); RESETBUF(inst->f, Char); Free(pie); } #undef maximumrange /* end module align.maxminalignment version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module align.withinalignment */ Static boolean withinalignment(alignedposition, alignedbase, length) long alignedposition, alignedbase, length; { /* this function tells one if an aligned position, relative to an aligned base in a piece of some length is within the piece. */ long p; /* the position on the piece */ p = alignedposition + alignedbase; return (p > 0 && p <= length); } /* end module align.withinalignment version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module book.getbase */ Static base getbase(position, pie) long position; piece *pie; { /* Get a base from the position (internal coordinates) of the piece. Protection is made against positions outside the piece. In the case of circles it would be convenient to wrap around when requests are off the end. So the routine will do a modular wrap for positions outside the range 1 to the length. This is a new feature as of 2000 March 22. */ dnastring *workdna; /* pointer to the dna part of pie */ long p; /* current count of bases into the workdna */ long spot; /* the last base of the dna part */ long thelength; /* the length of the piece */ /* writeln(output,'NEW getbase: position=',position:1,'^^^^^^^^^^^^^^^^^^^^'); */ /* handle cases of position out of range by circular wrapping */ thelength = piecelength(pie); while (position < 1) position += thelength; while (position > thelength) position -= thelength; workdna = pie->dna; p = workdna->length; while (position > p) { /* writeln(output,' workdna^.length=',workdna^.length:1); */ workdna = workdna->next; if (workdna == NULL) { printf("error in function getbase!\n"); halt(); } p += workdna->length; } /* writeln(output,'p=',p:1); */ if (true) { spot = workdna->length - p + position; /* writeln(output,'spot=',spot:1); showdnasegment(output,workdna, spot); */ if (spot <= 0) { printf("error in getbase, spot (= %ld) must be positive\n", spot); halt(); } if (spot > workdna->length) { printf("error in getbase, spot (=%ld) must be less than length (=%d)\n", spot, workdna->length); halt(); } /* writeln(output,'base = ', workdna^.part[spot]); */ return ((base)P_getbits_UB(workdna->part, spot - 1, 1, 3)); } printf("error in getbase: request off end of piece\n"); halt(); } /* Local variables for numberdigit: */ struct LOC_numberdigit { long number, place; /* the exponent of logplace */ long myabsolute; /* the absolute value of number */ Char acharacter; /* the character to be returned */ } ; Local Void digit(LINK) struct LOC_numberdigit *LINK; { /* extract a digit at the place position */ long tenplace; /* ten times place */ long z; /* an intermediate value */ long d; /* the digit extracted */ tenplace = LINK->place * 10; z = LINK->myabsolute - LINK->myabsolute / tenplace * tenplace; if (LINK->place == 1) d = z; else d = z / LINK->place; switch (d) { case 0: LINK->acharacter = '0'; break; case 1: LINK->acharacter = '1'; break; case 2: LINK->acharacter = '2'; break; case 3: LINK->acharacter = '3'; break; case 4: LINK->acharacter = '4'; break; case 5: LINK->acharacter = '5'; break; case 6: LINK->acharacter = '6'; break; case 7: LINK->acharacter = '7'; break; case 8: LINK->acharacter = '8'; break; case 9: LINK->acharacter = '9'; break; } } /* digit */ Local Void sign(LINK) struct LOC_numberdigit *LINK; { /* put a negative sign out or a positive sign */ if (LINK->number < 0) LINK->acharacter = '-'; else LINK->acharacter = '+'; } /* sign */ /* end module book.getbase version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module package.numbar */ /* ************************************************************************ */ /* begin module numberdigit */ Static Char numberdigit(number_, logplace) long number_, logplace; { /* return the digit at the place value ('logplace') position of number. example: numberdigit(13625, 3) = 3 numberdigit(13625, 4) = 1 2000 July 30 'myabsolute' replaced 'absolute', which is apparently a keyword for GPC. The name is kept to keep the code looking similar to its origin. */ struct LOC_numberdigit V; long count; /* used to make place */ V.number = number_; V.place = 1; for (count = 1; count <= logplace; count++) V.place *= 10; if (V.number == 0) { if (V.place == 1) V.acharacter = '0'; else V.acharacter = ' '; return V.acharacter; } V.myabsolute = labs(V.number); if (V.myabsolute < V.place / 10) { V.acharacter = ' '; return V.acharacter; } if (V.myabsolute >= V.place) digit(&V); else sign(&V); return V.acharacter; } /* numberdigit */ #define ln10 2.30259 /* natural log of 10 - for conversion to log base 10 */ #define epsilon 0.00001 /* a small number to correct log base 10 errors */ /* end module numberdigit version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* begin module numbersize */ Static long numbersize(n) long n; { /* calculate amount of space to be reserved for the integer n */ long size; /* intermediate result */ if (n == 0) return 1; else { /* account for minus sign */ size = (long)(log((double)labs(n)) / ln10 + epsilon) + 1; /* the 1 is for the last digit */ /* the epsilon assures that we do not lose a place due to roundoff. eg, sometimes log base 10 of 10 would be 0.9999 instead of 1, and we would not do it right... note: this will fail for very large numbers on the order of 1/epsilon. */ if (n < 0) size++; return size; } } /* numbersize */ #undef ln10 #undef epsilon /* end module numbersize version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* begin module numberbar */ Static long firstlastmax(firstnumber, lastnumber) long firstnumber, lastnumber; { /* compute the sizes of firstnumber and lastnumber (including + or - sign) and then determine which number is larger */ long firstlines; /* number of lines needed for firstumber */ long lastlines; /* number of lines needed for lastnumber */ firstlines = numbersize(firstnumber); if (firstnumber > 0) /* add one more for + sign */ firstlines++; lastlines = numbersize(lastnumber); if (lastnumber > 0) /* add one more for + sign */ lastlines++; if (firstlines > lastlines) return firstlines; else return lastlines; } Static Void numberbar(afile, spaces, firstnumber, lastnumber, linesused) _TEXT *afile; long spaces, firstnumber, lastnumber, *linesused; { /* write a bar of numbers to a file, with several spaces before. the number of lines used is returned */ long logplace; /* the log of the digit being looked at */ long number; /* the current number being written */ long spacecount; /* count of spaces */ /* 2000 June 24: This code was not sufficient to deal with the sign correctly. The numbersize routine now does *not* give the + sign (which makes it useful for other purposes) so we have to account for it here now. if abs(firstnumber) > abs(lastnumber) then linesused:= numbersize(firstnumber) else linesused:= numbersize(lastnumber); */ *linesused = firstlastmax(firstnumber, lastnumber); /* writeln(output,'numberbar says linesused = ',linesused:1); for logplace:=linesused-1 downto 0 do begin 1999 July 15: this is changed to linesused since numbersize now accounts for the sign: for logplace := linesused downto 0 do begin 2000 June 24: back to the old code ... */ for (logplace = *linesused - 1; logplace >= 0; logplace--) { for (spacecount = 1; spacecount <= spaces; spacecount++) putc(' ', afile->f); for (number = firstnumber; number <= lastnumber; number++) fputc(numberdigit(number, logplace), afile->f); putc('\n', afile->f); } } /* end module numberbar version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* ************************************************************************ */ /* end module package.numbar version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* begin module align.getpositions */ Static Void getpositions(inst, book, positionwidth, numberwidth, count, alignmenttype) _TEXT *inst, *book; long *positionwidth, *numberwidth, *count; Char alignmenttype; { /* number of pieces found */ /* prescan the book to find the width of position numbers and the number of fragments. Convert these to the minimum widths necessary to print them. NOTE: although one can count the number of pieces, this is not necessarily the number to use for numberwidth! The reason is that numbers are controlled by Delila. So one wants the max of the global 'number'. */ long ab = 0; /* maximum of the aligned base coordinates */ long coordinate; /* an alignment coordinate */ long maxnumber = 0; /* maximum of global 'number' */ boolean negatives; /* the maximum number was negative */ piece *pie; /* a piece of DNA */ long length, alignedbase; /* the length of the pie and its aligned base */ pie = (piece *)Malloc(sizeof(piece)); brinit(book, &theline); if (*inst->name != '\0') { if (inst->f != NULL) inst->f = freopen(inst->name, "r", inst->f); else inst->f = fopen(inst->name, "r"); } else rewind(inst->f); if (inst->f == NULL) _EscIO2(FileNotFound, inst->name); RESETBUF(inst->f, Char); *count = 0; /* p2c: alist.p: Note: Eliminated unused assignment statement [338] */ while (!BUFEOF(book->f)) { switch (alignmenttype) { case 'i': align(inst, book, &theline, &pie, &length, &alignedbase); break; case 'b': case 'f': /* read in the piece */ getpiece(book, &theline, &pie); break; } if (BUFEOF(book->f)) break; (*count)++; if (labs(number) > maxnumber) maxnumber = labs(number); /* p2c: alist.p: Note: Eliminated unused assignment statement [338] */ /* p2c: alist.p: Note: Eliminated unused assignment statement [338] */ switch (alignmenttype) { case 'f': coordinate = inttopie(1L, pie); break; case 'b': case 'i': coordinate = inttopie(alignedbase, pie); break; } if (labs(coordinate) > labs(ab)) ab = coordinate; clearpiece(&pie); } /* make the book readable again */ if (*book->name != '\0') { if (book->f != NULL) book->f = freopen(book->name, "r", book->f); else book->f = fopen(book->name, "r"); } else rewind(book->f); if (book->f == NULL) _EscIO2(FileNotFound, book->name); RESETBUF(book->f, Char); if (*inst->name != '\0') { if (inst->f != NULL) inst->f = freopen(inst->name, "r", inst->f); else inst->f = fopen(inst->name, "r"); } else rewind(inst->f); if (inst->f == NULL) _EscIO2(FileNotFound, inst->name); RESETBUF(inst->f, Char); Free(pie); /* Finally, determine the number of characters necessary for printing the number. Numbersize allows for a sign. A Delila instruction could give negative numbers to a piece. Otherwise, we remove the extra blank with the if statement below. */ *numberwidth = numbersize(maxnumber); /* this is old, not correct now that numbersize does this properly: if not negatives then numberwidth := numberwidth - 1; */ /* writeln(output,'count=',count:1); writeln(output,'numberwidth=',numberwidth:1); */ if (ab == 0) *positionwidth = 1; else *positionwidth = numbersize(ab); } /* end module align.getpositions */ Static Void noheader(a_) _TEXT *a_; { fprintf(a_->f, " %% NOHEADER FOR PACKAGING INTO ANOTHER FIGURE\n"); } Static Void removeit(a_) _TEXT *a_; { fprintf(a_->f, " %% REMOVE FOR PACKAGING INTO ANOTHER FIGURE\n"); } /* begin module pnumberbar */ Static Void pnumberbar(afile, spaces, firstnumber, lastnumber, linesused) _TEXT *afile; long spaces, firstnumber, lastnumber, *linesused; { /* write a bar of numbers to a file, with several spaces before. The number of lines used is returned. In this variant of numberbar lines are to be written in postscript. By doing things this way, upgrades to numberbar automatically get are applied to this routine. (I got caught on one upgrade that did not propagate to this routine!) */ _TEXT internal; /* internal file for creating the result */ internal.f = NULL; *internal.name = '\0'; if (*internal.name != '\0') { if (internal.f != NULL) internal.f = freopen(internal.name, "w", internal.f); else internal.f = fopen(internal.name, "w"); } else { if (internal.f != NULL) rewind(internal.f); else internal.f = tmpfile(); } if (internal.f == NULL) _EscIO2(FileNotFound, internal.name); SETUPBUF(internal.f, Char); numberbar(&internal, spaces, firstnumber, lastnumber, linesused); if (*internal.name != '\0') { if (internal.f != NULL) internal.f = freopen(internal.name, "r", internal.f); else internal.f = fopen(internal.name, "r"); } else rewind(internal.f); if (internal.f == NULL) _EscIO2(FileNotFound, internal.name); RESETBUF(internal.f, Char); while (!BUFEOF(internal.f)) { putc('(', afile->f); while (!P_eoln(internal.f)) { putc(P_peek(internal.f), afile->f); getc(internal.f); } fscanf(internal.f, "%*[^\n]"); getc(internal.f); fprintf(afile->f, ") sn\n"); } if (internal.f != NULL) fclose(internal.f); } /* end module pnumberbar */ /* begin module book.name */ Static Void clearname(n) name *n; { /* clear the name n */ long i; /* index to piece name */ n->length = 0; for (i = 0; i < namelength; i++) n->letters[i] = ' '; } Static Void writename(f, n) _TEXT *f; name n; { /* write the name n to file f */ long i; /* index to piece name */ for (i = 0; i < n.length; i++) putc(n.letters[i], f->f); } Static Void copyname(a_, b) name a_, *b; { /* copy name a to name b */ long i; /* index to piece name */ for (i = 0; i < a_.length; i++) b->letters[i] = a_.letters[i]; b->length = a_.length; } Static boolean equalname(a_, b) name a_, b; { /* is name a equal to name b? */ long i = 1; /* index to piece name */ boolean same = true; /* temporary variable to hold the answer */ /* what optimism!! */ if (b.length != a_.length) return false; while (same && i <= a_.length) { same = (b.letters[i-1] == a_.letters[i-1]); i++; /* p2c: alist.p: Note: Eliminated unused assignment statement [338] */ } return same; } /* end module book.name version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module book.brorgkey */ Static Void brorgkey(thefile, theline, org) _TEXT *thefile; long *theline; orgkey *org; { /* read organism key */ /*bbb*/ brheader(thefile, theline, &org->hea); getline(&org->mapunit); brline(thefile, theline, &org->mapunit); } /* end module book.brorgkey version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module book.brchrkey */ Static Void brchrkey(thefile, theline, chr) _TEXT *thefile; long *theline; chrkey *chr; { /* read chromosome key */ /*bbb*/ brheader(thefile, theline, &chr->hea); brreanum(thefile, theline, &chr->mapbeg); brreanum(thefile, theline, &chr->mapend); } /* end module book.brchrkey version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module book.getocp */ Static Void getocp(thefile, theline, org, orgchange, orgopen, chr, chrchange, chropen, pie, piechange, pieopen) _TEXT *thefile; long *theline; orgkey *org; boolean *orgchange, *orgopen; chrkey *chr; boolean *chrchange, *chropen; piece **pie; boolean *piechange, *pieopen; { /* Get the next piece and its organism and chromosome keys. The three change variables indicate whether or not a new organism, chromosome or piece name was found. If a piece is not found, then pieopen will be false. orgopen, chropen and pieopen are used by getocp to tell when it has entered an organism, chromosome or piece. All booleans should be set to false initially. There should be one triplet for each book read. It is important to initialize ALL variables, including pie: orgchange := false; orgopen := false; chrchange := false; chropen := false; piechange := false; pieopen := false; pie := nil; theline := 0; 1999 June 2 The book reading routines now treat data objects more precisely. Rather than test for eof, the endo of book occurs when pieopen is returned as false. A book reading loop now looks like this: repeat getocp(book, theline, org, orgchange, orgopen, chr, chrchange, chropen, pie, piechange, pieopen); writeln(output,'pieopen: ',pieopen); if pieopen then begin writeln(output,'piece at line: ',theline:1); end; until not pieopen; */ Char ch = 'a'; chrkey newchr; orgkey neworg; piece *newpie; long SET[5]; while (ch != 'p' && ch != ' ') { P_addset(P_expset(SET, 0L), 'o'); P_addset(SET, 'c'); ch = getto(thefile, theline, P_addset(SET, 'p')); if (ch == ' ') { *pieopen = false; break; } switch (ch) { case 'o': if (*orgopen) { fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); /* move past the word 'organism' - new definition 1999 Mar 13 */ *orgopen = false; /* close organism */ } else { brorgkey(thefile, theline, &neworg); if (strncmp(neworg.hea.keynam.letters, org->hea.keynam.letters, sizeof(alpha)) && neworg.hea.keynam.length != org->hea.keynam.length) { /* writeln(output,'--------orgchanged!'); write (output,'--------old org:"', org.hea.keynam.letters); writeln(output, '" ', org.hea.keynam.length:1); write (output,'--------new org:"',neworg.hea.keynam.letters); writeln(output, '" ',neworg.hea.keynam.length:1); */ /*ccc*/ *orgchange = true; copyheader(neworg.hea, &org->hea); /* move the mapunit over to the org! */ org->mapunit = neworg.mapunit; clearline(&neworg.mapunit); } else *orgchange = false; *orgopen = true; } break; case 'c': if (*chropen) { fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); /* move past the word 'chromosome' - new definition 1999 Mar 13 */ *chropen = false; /* close chromosome */ } else { brchrkey(thefile, theline, &newchr); if (strncmp(newchr.hea.keynam.letters, chr->hea.keynam.letters, sizeof(alpha)) && newchr.hea.keynam.length != chr->hea.keynam.length) { /* writeln(output,'--------chrchanged!'); write (output,'--------old chr:"', chr.hea.keynam.letters); writeln(output, '" ', chr.hea.keynam.length:1); write (output,'--------new chr:"',newchr.hea.keynam.letters); writeln(output, '" ',newchr.hea.keynam.length:1); */ *chrchange = true; copyheader(newchr.hea, &chr->hea); /* move the map range over to the chr! */ chr->mapbeg = newchr.mapbeg; chr->mapend = newchr.mapend; } else *chrchange = false; *chropen = true; } break; case 'p': if (*pieopen) { *pieopen = false; /* close last piece */ ch = 'a'; /* prevent falling out of the loop */ } else { newpie = (piece *)Malloc(sizeof(piece)); brpiece(thefile, theline, &newpie); if (*pie == NULL) *piechange = true; else { if (strncmp(newpie->key.hea.keynam.letters, (*pie)->key.hea.keynam.letters, sizeof(alpha)) && newpie->key.hea.keynam.length != (*pie)->key.hea.keynam.length) *piechange = true; else *piechange = false; } *pieopen = true; /* we always have to switch over to the new piece, because although the name may be the same, the DNA sequence could be different. That is, the book may contain two pieces with the same name, and we want to be sure to search the new one, not the old one. */ if (*pie != NULL) { clearpiece(pie); /* save the links */ Free(*pie); /* close up shop */ } *pie = newpie; } break; } } } #define debugging false #define boundary 2 /* origin: search version = 6.39 */ /* end module book.getocp version = 7.72; {of delmod.p 2007 Jul 23} */ /* begin module emptyfile */ Static boolean emptyfile(afile) _TEXT *afile; { /* This function is a replacement for eof() to get around a bug in the GPC compiler. The GPC bug is that end-of-file, as provided by eof(), is false when a file is empty. The way to get around it is to count characters in the file to determine if it is empty. Fortunately this is fast for large files because the count stops once a single or a few characters are seen. A single character will not do unfortunately because GPC will give an '*' for an empty file. So the test is for having a certain number (boundary) or fewer characters. This is not great, but it only means that the file must be at least 'boundary' characters long. Furthermore, since the file is being READ, the emptyfile test CANNOT be used in a loop to test for eof! Use emptyfile only to check that the file is empty. Use eof inside loops IF the file is not empty. Dr. Thomas D. Schneider National Institutes of Health National Cancer Institute Center for Cancer Research Nanobiology Program Molecular Information Theory Group Frederick, Maryland 21702-1201 toms@ncifcrf.gov permanent email: toms@alum.mit.edu (use only if first address fails) http://www.ccrnp.ncifcrf.gov/~toms/ */ boolean Result; /* one needs at least this many characters for a file to be considered 'non empty'. */ long lines = 0; /* count of lines in the file */ long chars = 0; /* count of characters in the file */ Char ch; /* a character in the file */ if (*afile->name != '\0') { if (afile->f != NULL) afile->f = freopen(afile->name, "r", afile->f); else afile->f = fopen(afile->name, "r"); } else rewind(afile->f); if (afile->f == NULL) _EscIO2(FileNotFound, afile->name); RESETBUF(afile->f, Char); while (!BUFEOF(afile->f) && chars < boundary) { if (P_eoln(afile->f)) { lines++; fscanf(afile->f, "%*[^\n]"); getc(afile->f); continue; } ch = getc(afile->f); if (ch == '\n') ch = ' '; if (debugging) { printf("ord(ch) = %12d\n", ch); printf(" ch = %c\n", ch); } chars++; } if (chars < boundary) Result = true; else Result = false; if (debugging) { printf("lines = %ld\n", lines); printf("chars = %ld\n", chars); if (chars < boundary) printf(" empty (file)\n"); else printf("NOT empty (file)\n"); } if (*afile->name != '\0') { if (afile->f != NULL) afile->f = freopen(afile->name, "r", afile->f); else afile->f = fopen(afile->name, "r"); } else rewind(afile->f); if (afile->f == NULL) _EscIO2(FileNotFound, afile->name); RESETBUF(afile->f, Char); /* put the file back at the start!! */ return Result; } #undef debugging #undef boundary /* end module emptyfile */ /* begin module getname */ Static Void getname(namebook, theline, nametype, typefound, aname, org, orgchange, orgopen, chr, chrchange, chropen, pie, piechange, pieopen) _TEXT *namebook; long theline; Char nametype, *typefound; name *aname; orgkey *org; boolean *orgchange, *orgopen; chrkey *chr; boolean *chrchange, *chropen; piece **pie; boolean *piechange, *pieopen; { /* get to the next name in name book, looking for an organism or the type defined by nametype. org/chr/pie and the change and open booleans keep track of where we are in the book. They are used by getocp. */ /* getname should eventually be replaced by a procedure that reads instructions rather than a book. ... 2000 May 9 probably not. */ /* writeln(output,'getname: searching for nametype=',nametype); */ if (BUFEOF(namebook->f)) { *typefound = ' '; /* ;writeln(output,'getname: typefound = "',typefound,'"'); ;write(output,'getname: obtained: "'); ;writename(output,aname); ;writeln(output,'" -----------------------'); ;writeln(output); */ return; } *typefound = '.'; do { getocp(&book, &theline, org, orgchange, orgopen, chr, chrchange, chropen, pie, piechange, pieopen); if (*pieopen) { *typefound = 'p'; *aname = (*pie)->key.hea.keynam; } else if (*chropen) { *typefound = 'c'; *aname = chr->hea.keynam; } else if (*orgopen) { *typefound = 'o'; *aname = org->hea.keynam; } else *typefound = ' '; } while (*typefound != nametype && *typefound != 'o' && *typefound != ' '); } /* end module getname */ /* begin module maxname */ Static Void maxname(namebook, theline, nametype, namewidth, tofile, linenumber, org, orgchange, orgopen, chr, chrchange, chropen, pie, piechange, pieopen) _TEXT *namebook; long theline; Char nametype; long *namewidth; _TEXT *tofile; long *linenumber; orgkey *org; boolean *orgchange, *orgopen; chrkey *chr; boolean *chrchange, *chropen; piece **pie; boolean *piechange, *pieopen; { /* figure out the maximum length needed to be allocated to print the names, print book information in tofile, and increment linenumber of tofile */ name aname; /* a name */ Char typefound = '.'; /* what thing was found */ if (*namebook->name != '\0') { if (namebook->f != NULL) namebook->f = freopen(namebook->name, "r", namebook->f); else namebook->f = fopen(namebook->name, "r"); } else rewind(namebook->f); if (namebook->f == NULL) _EscIO2(FileNotFound, namebook->name); RESETBUF(namebook->f, Char); *namewidth = 0; if (emptyfile(namebook)) return; brinit(namebook, &theline); *orgchange = false; *chrchange = false; *piechange = false; *orgopen = false; *chropen = false; *pieopen = false; if (headercontrol == 'h') { switch (nametype) { case 'g': fprintf(tofile->f, "gene"); break; case 't': fprintf(tofile->f, "transcript"); break; case 'p': fprintf(tofile->f, "piece"); break; } fprintf(tofile->f, " names from:\n"); splitbooktitle(namebook, tofile); theline++; *linenumber += 2; } *orgopen = false; while (typefound != ' ') { getname(namebook, theline, nametype, &typefound, &aname, org, orgchange, orgopen, chr, chrchange, chropen, pie, piechange, pieopen); if (typefound != ' ' && typefound != 'o') { /* is g t or p */ if (typefound == nametype) { if (aname.length > *namewidth) *namewidth = aname.length; } } } } /* end module maxname */ /* begin module maxfullnamewidth */ Static Void maxfullnamewidth(book, theline, fullnamewidth) _TEXT *book; long theline, *fullnamewidth; { /* figure out the maximum length needed to be allocated to print long names */ line *fullname; /* line containing fullname */ Char typefound; /* what thing was found */ long SET[5]; if (*book->name != '\0') { if (book->f != NULL) book->f = freopen(book->name, "r", book->f); else book->f = fopen(book->name, "r"); } else rewind(book->f); if (book->f == NULL) _EscIO2(FileNotFound, book->name); RESETBUF(book->f, Char); *fullnamewidth = 0; /*writeln(output,'maxfullnamewidth');*/ while (!BUFEOF(book->f)) { /*writeln(output,'@',book^);*/ typefound = getto(book, &theline, P_addset(P_expset(SET, 0L), 'p')); if (typefound != 'p') continue; fscanf(book->f, "%*[^\n]"); getc(book->f); /* skip name */ fscanf(book->f, "%*[^\n]"); getc(book->f); /* get full name */ getline(&fullname); brline(book, &theline, &fullname); /* write(output,'maxfullnamewidth name: "'); for index := 1 to fullname^.length do write(output, fullname^.letters[index]); writeln(output,'"'); */ if (fullname->length > *fullnamewidth) *fullnamewidth = fullname->length; /* writeln(output,'fullnamewidth:', fullnamewidth:1); */ clearline(&fullname); /* locate end of piece */ typefound = getto(book, &theline, P_addset(P_expset(SET, 0L), 'p')); if (typefound != 'p') { printf("book structure is bad: a piece does not have an end\n"); halt(); } fscanf(book->f, "%*[^\n]"); getc(book->f); theline++; } /* writeln(output,'ending fullnamewidth:', fullnamewidth:1); */ /*uuu BUBBA*/ /* writeln(output, '************** fullnamewidth = ', fullnamewidth:5,' ******'); */ } /* end module maxfullnamewidth */ /* begin module printname */ Static Void printname(namebook, theline, nametype, namewidth, tofile, ctofile, org, orgchange, orgopen, chr, chrchange, chropen, pie, piechange, pieopen, linenumber, clinenumber) _TEXT *namebook; long theline; Char nametype; long namewidth; _TEXT *tofile, *ctofile; orgkey *org; boolean *orgchange, *orgopen; chrkey *chr; boolean *chrchange, *chropen; piece **pie; boolean *piechange, *pieopen; long *linenumber, *clinenumber; { /* print names of items in the book from namebook to tofile. organism is always printed, and one other type specified by nametype (one of 'g', 't', 'p') is printed namewidth wide. orgopen is used to keep track of the organism. */ name aname; /* the name found */ Char typefound; /* the type of the name */ long index; /* for printing the name */ do { getname(namebook, theline, nametype, &typefound, &aname, org, orgchange, orgopen, chr, chrchange, chropen, pie, piechange, pieopen); if (typefound != ' ') { switch (typefound) { case 'o': fprintf(tofile->f, "\n organism %.*s\n", namelength, aname.letters); fprintf(ctofile->f, "\n organism %.*s\n", namelength, aname.letters); *linenumber += 2; /* two lines written */ *clinenumber += 2; /* two lines written */ break; case 'g': case 't': case 'p': putc(' ', tofile->f); putc(' ', ctofile->f); for (index = 0; index < namewidth; index++) putc(aname.letters[index], tofile->f); for (index = 0; index < namewidth; index++) putc(aname.letters[index], ctofile->f); break; } } } while (typefound != nametype && typefound != ' '); } /* end module printname */ /* begin module maxnamelist */ Static Void maxnamelist(namelist, namelistwidth) _TEXT *namelist; long *namelistwidth; { /* determine the length of the longest line in namelist. */ Char c_; /* a character for reading namelist */ long currentmax = 1; /* the current maximum */ long count = 0; /* count of characters in the file. This is to get around a problem in GPC: GPC does not give file EOF when the file has been reset! */ if (*namelist->name != '\0') { if (namelist->f != NULL) namelist->f = freopen(namelist->name, "r", namelist->f); else namelist->f = fopen(namelist->name, "r"); } else rewind(namelist->f); if (namelist->f == NULL) _EscIO2(FileNotFound, namelist->name); RESETBUF(namelist->f, Char); if (emptyfile(namelist)) { *namelistwidth = 0; /* writeln(output,' namelistwidth = ',namelistwidth:1); writeln(output,' count = ',count:1); */ return; } /* allow 1 space at the start */ while (!BUFEOF(namelist->f)) { if (P_eoln(namelist->f)) { fscanf(namelist->f, "%*[^\n]"); getc(namelist->f); if (currentmax > *namelistwidth) *namelistwidth = currentmax; currentmax = 1; /* allow 1 space at the start */ continue; } c_ = getc(namelist->f); if (c_ == '\n') c_ = ' '; count++; currentmax++; } } /* end module maxnamelist */ /* begin module makelogo.protectcharacter */ Static Void protectcharacter(c_, protectioncharacter, needed) Char c_, *protectioncharacter; boolean *needed; { /* In PostScript, special characters must be protected against. This routine looks at a character c and returns a protection character if it is needed. The parenthesis is used in PostScript to indicate the bounds of a string, while the percent is the comment character. The backslash also needs protection, since it is the escape to indicate that the next character is part of the string. */ if (c_ == '\\' || c_ == '%' || c_ == ')' || c_ == '(') { *protectioncharacter = '\\'; *needed = true; } else { *protectioncharacter = ' '; *needed = false; } } /* end module makelogo.protectcharacter version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* begin module makelogo.protectpostscript */ Static Void protectpostscript(afile, c_) _TEXT *afile; Char c_; { /* Special characters must be protected against! Put out a protective backslash for character c which would otherwise destroy the PostScript interpreter. The parenthesis is used in PostScript to indicate the bounds of a string, while the percent is the comment character. The backslash also needs protection, since it is the escape to indicate that the next character is part of the string. */ boolean needed; /* is protection needed? */ Char protectionchar; /* is protection needed? */ protectcharacter(c_, &protectionchar, &needed); if (needed) putc(protectionchar, afile->f); } /* end module makelogo.protectpostscript version = 5.27; (@ of prgmod.p 2005 Aug 06 */ Static Void figureblanks(blanks) long *blanks; { /* figure out how many blanks to use in the display for numberbar */ /* the blank before the sequences and the name list width */ *blanks = namelistwidth + 1; if (!emptyfile(&namebook)) *blanks += namewidth + 1; /*BUBBA uuu blanks := 0; this removes the extra blanks for the number */ /* 1 blank for orientation character + 1 more for spacing = +2 */ if (displaylevel == 'p') *blanks += namewidth + positionwidth + 3; if (displaylevel == 'c') *blanks += positionwidth + 3; if (numbered) *blanks += numberwidth + 1; if (usefullname == 'l') /* note the extra blank for padding */ *blanks += fullnamewidth + 1; /*writeln(output,'blanks = ',blanks:1);*/ } #define debugging false /* debugging the postscript */ /* begin module alist.startpostscript */ Static Void startpostscript(a_, colors, programname, deltaXcm, deltaYcm, scaleimage, defaultllx_, defaultlly_, defaulturx_, defaultury_, fromdo, todo, sequences, cmfactor, headerclinenumber) _TEXT *a_, *colors; name programname; double deltaXcm, deltaYcm, scaleimage, defaultllx_, defaultlly_, defaulturx_, defaultury_; long fromdo, todo, sequences; double cmfactor; long headerclinenumber; { /* lower left x */ /* lower left y */ /* upper left x */ /* upper left y */ /* range of sequences */ /* number of sequences in book */ /* convert from cm to points */ /* the number of lines used by the first page header of clist: */ /* start writing postscript for color text lines to file a, using the colors file for color definitions. programname is the name of this program. deltaXcm and deltaYcm determine how much to move the image on the page. scaleimage is the scaling factor from the upper left hand corner. the llx, lly, urx, ury parameters determine where the image resides. lines is the number of lines to account for vertically. headercontrol controls the header at the start of the file. */ long i; /* index to the name n */ double red, green, blue; /* colors */ Char symbol; /* one of the bases */ double currentdisplay; /* current display width in points */ double requireddisplay; /* required display width in points */ double pointcorrection; /* requireddisplay - currentdisplay */ long lines; /* maximum number of lines on a page, based on number of sequences */ long numbarlines; /* lines used by number */ long actuallines; /* actual lines required for the page */ /* compute available page length in lines. */ cpagelength = (long)((defaultury_ - defaultlly_) / fontsize); /* we are sure to do the sequences! */ actuallines = sequences; /* account for the numbar if we are going to do one */ if (headercontrol != '0') { numbarlines = firstlastmax(fromdo, todo); /* the extra +1 is the dots between the numbar and the sequence */ actuallines += numbarlines + 1; } /* account for the non-number header lines if we are going to do them */ if (headercontrol == 'h') actuallines += headerclinenumber; /* writeln(output,'START>>>> clinenumber = ',clinenumber:1); writeln(output,'>>>> clinenumber = ',clinenumber:1); writeln(output,' actual headerclinenumber = ',headerclinenumber:1); writeln(output,' const headerclines = ',headerclines:1); */ /* At this point the actual number of header lines written out is is 0 since nothing has been written to clist yet. But we need to compute things from how many there will be later. To do that, the constant headerclines is used. Just after writing the header the program checks that headerclinenumber does indeed match headerclines. If they don't it is a program error and the counting of headerclinenumber should be made to match the actual number of clist header lines produced. */ if (actuallines < cpagelength) lines = actuallines; else lines = cpagelength; /*zboundingbox*/ if (debugging) { printf("-------------------\n"); printf("fromdo = %ld\n", fromdo); printf(" todo = %ld\n", todo); printf("numbersize(fromdo) = %ld\n", numbersize(fromdo)); printf("numbersize( todo) = %ld\n", numbersize(todo)); printf("numbarlines = %ld\n", numbarlines); printf("sequences = %ld\n", sequences); printf("headerlines = %ld\n", (long)headerlines); printf("actuallines = %ld\n", actuallines); printf("cpagelength = %ld\n", cpagelength); printf("lines = %ld\n", lines); printf("-------------------\n"); printf("cmfactor = %1.1f\n", cmfactor); printf("defaultury = %1.1f\n", defaultury_); printf("defaultlly = %1.1f\n", defaultlly_); printf("(defaultury-defaultlly)/cmfactor = %1.1f\n", (defaultury_ - defaultlly_) / cmfactor); printf("(defaultury-defaultlly) = %1.1f\n", defaultury_ - defaultlly_); printf("-------------------\n\n"); } /*writeln(output,'edgecontrol = "',edgecontrol,'"');*/ if (edgecontrol != 'p') { /* figure out the total display width */ figureblanks(&blanks); /* writeln(output,'***************************************'); writeln(output,'before startpostscript data available: '); writeln(output,'blanks = ',blanks:3); writeln(output,'fromdo = ',fromdo:3); writeln(output,'todo = ',todo:3); writeln(output,'columnlength = ',columnlength:3); writeln(output,'columnwid = ',columnwid:3); */ /* the blanks are the part to the left of the numbar fromdo and todo are the range of the sequence 3 is the space around the display (about 1.5 char on both sides) columnlength is the length of the columnname */ displaywidth = blanks + todo - fromdo + 4; if (columnlength > columnwid) displaywidth += columnlength; else displaywidth += columnwid; /* writeln(output,'displaywidth = ', displaywidth:3); writeln(output,'***************************************'); */ /* writeln(output,'BEFORE urx = ', urx:1:3); writeln(output,'fontsize = ', fontsize:1:3); */ if (colorlistcontrol != 'R') { /* portrait */ llx = defaultllx_; /* lower left x */ lly = defaultlly_; /* lower left y */ urx = defaulturx_; /* upper left x */ ury = defaultury_; /* upper left y */ currentdisplay = urx - llx; /* at least make sure that the whole display can be seen */ requireddisplay = fontsize * defcharacterratio * displaywidth; pointcorrection = requireddisplay - currentdisplay; /* writeln(output,'requireddisplay = ', requireddisplay:1:1); writeln(output,'currentdisplay = ', currentdisplay :1:1); writeln(output,'pointcorrection = ', pointcorrection:1:1); writeln(output,'AFTER urx = ', urx:1:3); */ urx += pointcorrection; llx -= edgeleft * cmfactor; lly -= edgelow * cmfactor; urx += edgeright * cmfactor; ury += edgehigh * cmfactor; /* remove extra blanks from the bottom of the bounding box */ lly += (cpagelength - lines) * fontsize; /*zboundingbox*/ /* writeln(output,'(cpagelength - lines) = ',(cpagelength - lines):1); writeln(output,'fontsize = ',fontsize:1); */ } else { /* lower left y NOTE SWITCH!! */ llx = defaultlly_; /* lower left x NOTE SWITCH!! */ lly = defaultllx_; urx = defaultury_; /* upper left x NOTE SWITCH!! */ ury = defaulturx_; /* upper left y NOTE SWITCH!! */ currentdisplay = ury - lly; /* at least make sure that the whole display can be seen */ requireddisplay = fontsize * defcharacterratio * displaywidth; pointcorrection = requireddisplay - currentdisplay; /* writeln(output,'requireddisplay = ', requireddisplay:1:1); writeln(output,'currentdisplay = ', currentdisplay :1:1); writeln(output,'pointcorrection = ', pointcorrection:1:1); */ ury += pointcorrection; llx -= edgehigh * cmfactor; lly -= edgeleft * cmfactor; urx += edgelow * cmfactor; ury += edgeright * cmfactor; /* remove extra blanks from the bottom of the bounding box */ urx += (lines - cpagelength) * fontsize; /*zboundingbox*/ } /* rotation to landscape */ /* move the display around to always match: */ llx += deltaXcm * cmfactor; lly += deltaYcm * cmfactor; urx += deltaXcm * cmfactor; ury += deltaYcm * cmfactor; } fprintf(a_->f, "%%!PS-Adobe-2.0 EPSF-2.0\n"); fprintf(a_->f, "%%%%Title: "); for (i = 0; i < programname.length; i++) putc(programname.letters[i], a_->f); fprintf(a_->f, " %4.2f\n", version); fprintf(a_->f, "%%%%Creator: Tom Schneider\n"); fprintf(a_->f, "%%%%BoundingBox: %5ld %5ld %5ld %5ld\n", (long)floor(llx + 0.5), (long)floor(lly + 0.5), (long)floor(urx + 0.5), (long)floor(ury + 0.5)); fprintf(a_->f, "%%%%Pages: 1\n"); fprintf(a_->f, "%%%%DocumentFonts:\n"); fprintf(a_->f, "%%%%EndComments\n"); fprintf(a_->f, "%%%%EndProlog\n"); fprintf(a_->f, "/cmfactor 72 2.54 div def %% defines points -> centimeters\n"); fprintf(a_->f, "/cm { cmfactor mul} def %% defines centimeters\n"); fprintf(a_->f, "/llx %5.1f def\n", llx); fprintf(a_->f, "/lly %5.1f def\n", lly); fprintf(a_->f, "/urx %5.1f def\n", urx); fprintf(a_->f, "/ury %5.1f def\n", ury); fprintf(a_->f, "/edgecontrol (%c) def\n", edgecontrol); fprintf(a_->f, "/edgeleft %*.*f cm def\n", pwid, pdec, edgeleft); fprintf(a_->f, "/edgeright %*.*f cm def\n", pwid, pdec, edgeright); fprintf(a_->f, "/edgelow %*.*f cm def\n", pwid, pdec, edgelow); fprintf(a_->f, "/edgehigh %*.*f cm def\n\n", pwid, pdec, edgehigh); /* move image and scale it: */ fprintf(a_->f, "/deltaXcm %10.5f cm def\n", deltaXcm); fprintf(a_->f, "/deltaYcm %10.5f cm def\n", deltaYcm); fprintf(a_->f, "/scaleimage %10.5f def\n", scaleimage); fprintf(a_->f, "/colorlistcontrol (%c) def\n\n", colorlistcontrol); fprintf(a_->f, "%% based on typefaces program from page 40 of the Blue book\n\n"); fprintf(a_->f, "%% variables\n"); fprintf(a_->f, "/defcharacterratio %*.*f def\n", pwid, pdec, defcharacterratio); fprintf(a_->f, "/fontsize %ld def\n", fontsize); fprintf(a_->f, "/lineseparation fontsize def\n"); fprintf(a_->f, "/thefont /Courier-Bold def\n\n"); fprintf(a_->f, "%% set the font\n"); /* original code: writeln(a,'thefont findfont fontsize scalefont setfont'); writeln(a); */ /* 2005 Jan 26: f function for fonts */ fprintf(a_->f, "/f {findfont fontsize scalefont setfont} def\n"); fprintf(a_->f, "thefont f\n\n"); fprintf(a_->f, "/dosymbol {%% dosymbol [symbol] - make a symbol\n"); fprintf(a_->f, "%% see page 272 in the Red book\n"); fprintf(a_->f, "/thissymbol exch def\n"); fprintf(a_->f, "%% switch to the Symbol font\n"); fprintf(a_->f, "/Symbol f\n"); fprintf(a_->f, "thissymbol show\n"); fprintf(a_->f, "%% switch back to the standard font\n"); fprintf(a_->f, "thefont f\n"); fprintf(a_->f, "} def\n"); fprintf(a_->f, "/n {\n"); fprintf(a_->f, "/currenty currenty lineseparation sub def\n"); fprintf(a_->f, "0 currenty moveto} def\n"); fprintf(a_->f, "/s {show} def\n"); fprintf(a_->f, "/sn {s n} def\n\n"); fprintf(a_->f, "colorlistcontrol (R) ne\n"); /* default is portrait mode */ fprintf(a_->f, "{ %% normal page display: portrait mode\n"); fprintf(a_->f, " /topofpage %*.*f cm def\n", pwid, pdec, topofpage); fprintf(a_->f, " /startpage{\n"); /*zboundingbox*/ /* the factor of a single fontsize is empirical ... */ fprintf(a_->f, " deltaXcm fontsize add deltaYcm translate\n"); fprintf(a_->f, " scaleimage dup scale\n"); fprintf(a_->f, " 0 topofpage moveto\n"); /* get current x and y, throw away the x: */ fprintf(a_->f, " /currenty currentpoint exch pop def\n"); fprintf(a_->f, " } def\n"); fprintf(a_->f, "}\n"); /* --------------------------- */ fprintf(a_->f, "{ %% page rotation to landscape mode\n"); fprintf(a_->f, " /topofpage %*.*f cm def\n", pwid, pdec, 0.0); fprintf(a_->f, " /startpage{\n"); /*zboundingbox*/ /* the factor of 1.5 is empirical ... */ fprintf(a_->f, " deltaXcm fontsize 1.5 mul add\n"); fprintf(a_->f, " deltaYcm fontsize defcharacterratio 2 mul mul add\n"); fprintf(a_->f, " translate\n"); fprintf(a_->f, " +90 rotate\n"); fprintf(a_->f, " scaleimage dup scale\n"); fprintf(a_->f, " 0 topofpage moveto\n"); /* get current x and y, throw away the x: */ fprintf(a_->f, " /currenty currentpoint exch pop def\n"); fprintf(a_->f, " } def\n"); fprintf(a_->f, "}\n"); fprintf(a_->f, "ifelse\n\n"); if (*colors->name != '\0') { if (colors->f != NULL) colors->f = freopen(colors->name, "r", colors->f); else colors->f = fopen(colors->name, "r"); } else { /* set up the color statements */ rewind(colors->f); } if (colors->f == NULL) _EscIO2(FileNotFound, colors->name); RESETBUF(colors->f, Char); if (!BUFEOF(colors->f)) { while (!BUFEOF(colors->f)) { if (P_peek(colors->f) == '*') { /* skip comment lines */ fscanf(colors->f, "%*[^\n]"); getc(colors->f); continue; } /* implement the backslash protection scheme: */ if (P_peek(colors->f) == '\\') getc(colors->f); fscanf(colors->f, "%c%lg%lg%lg%*[^\n]", &symbol, &red, &green, &blue); getc(colors->f); if (symbol == '\n') symbol = ' '; putc('/', a_->f); protectpostscript(a_, symbol); fprintf(a_->f, "%c{", symbol); if (red == 1.0 || red == 0.0) fprintf(a_->f, "%ld", (long)floor(red + 0.5)); else fprintf(a_->f, "%*.*f", pwid, pdecolor, red); putc(' ', a_->f); if (green == 1.0 || green == 0.0) fprintf(a_->f, "%ld", (long)floor(green + 0.5)); else fprintf(a_->f, "%*.*f", pwid, pdecolor, green); putc(' ', a_->f); if (blue == 1.0 || blue == 0.0) fprintf(a_->f, "%ld", (long)floor(blue + 0.5)); else fprintf(a_->f, "%*.*f", pwid, pdecolor, blue); fprintf(a_->f, " setrgbcolor (%c) s} def\n", symbol); } } else { fprintf(a_->f, "/a {0 1 0 setrgbcolor (a) s} def\n"); fprintf(a_->f, "/c {0 0.9372 1 setrgbcolor (c) s} def\n"); fprintf(a_->f, "/g {1 0.7 0 setrgbcolor (g) s} def\n"); fprintf(a_->f, "/t {1 0 0 setrgbcolor (t) s} def\n\n"); } fprintf(a_->f, "/b {0 0 0 setrgbcolor} def\n"); /* set black */ fprintf(a_->f, "/e {( ) s} def\n"); /* make empty space */ } #undef debugging /* end module alist.startpostscript */ Static Void readcolumnname(f) _TEXT *f; { /* read the columnname from file f */ boolean done = false; /* done reading f? */ if (*f->name != '\0') { if (f->f != NULL) f->f = freopen(f->name, "r", f->f); else f->f = fopen(f->name, "r"); } else rewind(f->f); if (f->f == NULL) _EscIO2(FileNotFound, f->name); RESETBUF(f->f, Char); readvalues = false; columnlength = 0; if (!BUFEOF(f->f)) { getc(f->f); /* skip the "*" */ if (!P_eoln(f->f)) { getc(f->f); /* skip the " " */ if (!P_eoln(f->f)) { while (!P_eoln(f->f)) { columnlength++; columnname[columnlength-1] = getc(f->f); if (columnname[columnlength-1] == '\n') columnname[columnlength-1] = ' '; readvalues = true; } fscanf(f->f, "%*[^\n]"); getc(f->f); } } } /* Skip through header information. If we hit end of file, then there is no data and readvalues should be false. */ if (!readvalues) return; while (!done) { if (BUFEOF(f->f)) { readvalues = false; done = true; } else { if (P_peek(f->f) == '*') { fscanf(f->f, "%*[^\n]"); getc(f->f); } else done = true; } } } Static Void writecolumnname(f) _TEXT *f; { /* write the columnname to file f */ long i; /* index to the column name */ long FORLIM; FORLIM = columnlength; for (i = 0; i < FORLIM; i++) putc(columnname[i], f->f); } Static Void getcolumnvalue(f, column, value) _TEXT *f; long column; double *value; { /* get the column value from file f */ long c_; /* index to the columns */ boolean gotit = false; /* whether we got the value */ while (!BUFEOF(f->f) && !gotit) { if (P_peek(f->f) == '*') { fscanf(f->f, "%*[^\n]"); getc(f->f); continue; } for (c_ = 1; c_ < column; c_++) skipcolumn(f); if (BUFEOF(f->f)) break; fscanf(f->f, "%lg%*[^\n]", value); getc(f->f); gotit = true; } if (gotit) return; printf("getcolumnvalue: could not locate the column %ld value\n", column); printf("in the avalues file at sequence number %ld\n", number); if (BUFEOF(f->f)) printf("end of file avalues was found\n"); halt(); } Static Void showalignment() { /* show the numbers of all the bases relative to aligned base */ long lines, blanks, index, FORLIM; figureblanks(&blanks); numberbar(&list, blanks, fromdo, todo, &lines); /* now show a bar of dots to make it easier to read */ for (index = 1; index <= blanks; index++) putc(' ', list.f); FORLIM = todo; for (index = fromdo; index <= FORLIM; index++) putc('.', list.f); if (readvalues) { putc(' ', list.f); writecolumnname(&list); } putc('\n', list.f); linenumber += lines + 1; } Static Void cshowalignment() { /* show the numbers of all the bases relative to aligned base in color */ long lines, blanks, index, FORLIM; figureblanks(&blanks); /* writeln(output,'positionwidth=',positionwidth:1); writeln(output,'namewidth=',namewidth:1); writeln(output,'numberwidth=',numberwidth:1); writeln(output,'blanks=',blanks:1); */ pnumberbar(&clist, blanks, fromdo, todo, &lines); /* now show a bar of dots to make it easier to read */ putc('(', clist.f); for (index = 1; index <= blanks; index++) putc(' ', clist.f); FORLIM = todo; for (index = fromdo; index <= FORLIM; index++) putc('.', clist.f); if (readvalues) { putc(' ', clist.f); writecolumnname(&clist); } fprintf(clist.f, ") sn"); if (cpagenumber > 1) removeit(&clist); else putc('\n', clist.f); clinenumber += lines + 1; } Static Void showpage(a_) _TEXT *a_; { /* show the page */ fprintf(a_->f, "b\n"); fprintf(a_->f, "showpage"); removeit(a_); } /* Local variables for checknumber: */ struct LOC_checknumber { _TEXT *afile; boolean ok; /* result of this check */ } ; Local Void conclude(LINK) struct LOC_checknumber *LINK; { _TEXT TEMP; printf("Including this character, the rest of the data line is:\n"); TEMP.f = stdout; *TEMP.name = '\0'; copyaline(LINK->afile, &TEMP); LINK->ok = false; } /* begin module checknumber */ Static boolean checknumber(afile_) _TEXT *afile_; { /* check that there is a number next in the file. If not, return false. This is useful for protection when reading a parameter file. */ struct LOC_checknumber V; V.afile = afile_; V.ok = true; /* be optimistic */ if (BUFEOF(V.afile->f)) { V.ok = false; printf("A number was expected on a data line, but"); printf(" the end of the file was found instead.\n"); return false; } skipblanks(V.afile); if (P_eoln(V.afile->f)) { printf("A number was expected on a data line, but"); printf(" the end of the line was found instead.\n"); conclude(&V); } if (P_peek(V.afile->f) == '+' || P_peek(V.afile->f) == '-' || P_peek(V.afile->f) == '.' || P_peek(V.afile->f) == '9' || P_peek(V.afile->f) == '8' || P_peek(V.afile->f) == '7' || P_peek(V.afile->f) == '6' || P_peek(V.afile->f) == '5' || P_peek(V.afile->f) == '4' || P_peek(V.afile->f) == '3' || P_peek(V.afile->f) == '2' || P_peek(V.afile->f) == '1' || P_peek(V.afile->f) == '0') return V.ok; printf("A number was expected on a data line, but"); printf(" the character \"%c\" was found instead.\n", P_peek(V.afile->f)); conclude(&V); return V.ok; } /* end module checknumber version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* begin module copyfile */ Static Void copyfile(fin, fout) _TEXT *fin, *fout; { /* copy the rest of file fin to fout */ while (!BUFEOF(fin->f)) copyaline(fin, fout); } /* end module copyfile version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* begin module almostcopyfile */ Static Void almostcopyfile(fin, fout) _TEXT *fin, *fout; { /* copy file fin to fout EXCEPT the last line, which for an old alist file was: alistp: parameters for alist 5.85 and higher This is detected by an 'a' being in the first line. Crude but effective ... */ while (!BUFEOF(fin->f)) { if (P_peek(fin->f) != 'a') copyaline(fin, fout); else { fscanf(fin->f, "%*[^\n]"); getc(fin->f); } } } /* end module almostcopyfile */ /* begin module alist.upgradeto596 */ Static Void upgradeto596() { /* upgrade the alistp file to version 5.96. This allows me to do multiple upgrade routines. */ _TEXT internal; /* a place to hold the old alistp */ internal.f = NULL; *internal.name = '\0'; parameterversion = 5.96; printf("upgrading to version %4.2f ...\n", parameterversion); if (*alistp.name != '\0') { if (alistp.f != NULL) alistp.f = freopen(alistp.name, "r", alistp.f); else alistp.f = fopen(alistp.name, "r"); } else rewind(alistp.f); if (alistp.f == NULL) _EscIO2(FileNotFound, alistp.name); RESETBUF(alistp.f, Char); /* there was no version parameter to skip before this point */ if (*internal.name != '\0') { if (internal.f != NULL) internal.f = freopen(internal.name, "w", internal.f); else internal.f = fopen(internal.name, "w"); } else { if (internal.f != NULL) rewind(internal.f); else internal.f = tmpfile(); } if (internal.f == NULL) _EscIO2(FileNotFound, internal.name); SETUPBUF(internal.f, Char); almostcopyfile(&alistp, &internal); if (*alistp.name != '\0') { if (alistp.f != NULL) alistp.f = freopen(alistp.name, "w", alistp.f); else alistp.f = fopen(alistp.name, "w"); } else { if (alistp.f != NULL) rewind(alistp.f); else alistp.f = tmpfile(); } if (alistp.f == NULL) _EscIO2(FileNotFound, alistp.name); SETUPBUF(alistp.f, Char); fprintf(alistp.f, "%4.2f version of alistp that this parameter file is designed for.\n", parameterversion); if (*internal.name != '\0') { if (internal.f != NULL) internal.f = freopen(internal.name, "r", internal.f); else internal.f = fopen(internal.name, "r"); } else rewind(internal.f); if (internal.f == NULL) _EscIO2(FileNotFound, internal.name); RESETBUF(internal.f, Char); copyfile(&internal, &alistp); /* add the new material at the end: */ fprintf(alistp.f, "n 0 0 0 0 edgecontrol (p=page), edgeleft, edgeright, edgelow, edgehigh in cm\n"); if (*alistp.name != '\0') { if (alistp.f != NULL) alistp.f = freopen(alistp.name, "r", alistp.f); else alistp.f = fopen(alistp.name, "r"); } else rewind(alistp.f); if (alistp.f == NULL) _EscIO2(FileNotFound, alistp.name); RESETBUF(alistp.f, Char); /* ready to start reading again */ if (internal.f != NULL) fclose(internal.f); } /* end module alist.upgradeto596 */ /* begin module alist.upgradeto598 */ Static Void upgradeto598() { /* upgrade the alistp file to version 5.98: add fontsize and the deltaXcm, deltaYcm, and scaleimage parameters */ _TEXT internal; /* a place to hold the old alistp */ internal.f = NULL; *internal.name = '\0'; parameterversion = 5.98; printf("upgrading to version %4.2f ...\n", parameterversion); /* copy alist to internal */ if (*alistp.name != '\0') { if (alistp.f != NULL) alistp.f = freopen(alistp.name, "r", alistp.f); else alistp.f = fopen(alistp.name, "r"); } else rewind(alistp.f); if (alistp.f == NULL) _EscIO2(FileNotFound, alistp.name); RESETBUF(alistp.f, Char); fscanf(alistp.f, "%*[^\n]"); getc(alistp.f); /* skip old parameter version line */ if (*internal.name != '\0') { if (internal.f != NULL) internal.f = freopen(internal.name, "w", internal.f); else internal.f = fopen(internal.name, "w"); } else { if (internal.f != NULL) rewind(internal.f); else internal.f = tmpfile(); } if (internal.f == NULL) _EscIO2(FileNotFound, internal.name); SETUPBUF(internal.f, Char); copyfile(&alistp, &internal); /* copy internal to alist */ if (*internal.name != '\0') { if (internal.f != NULL) internal.f = freopen(internal.name, "r", internal.f); else internal.f = fopen(internal.name, "r"); } else rewind(internal.f); if (internal.f == NULL) _EscIO2(FileNotFound, internal.name); RESETBUF(internal.f, Char); if (*alistp.name != '\0') { if (alistp.f != NULL) alistp.f = freopen(alistp.name, "w", alistp.f); else alistp.f = fopen(alistp.name, "w"); } else { if (alistp.f != NULL) rewind(alistp.f); else alistp.f = tmpfile(); } if (alistp.f == NULL) _EscIO2(FileNotFound, alistp.name); SETUPBUF(alistp.f, Char); fprintf(alistp.f, "%4.2f version of alistp that this parameter file is designed for.\n", parameterversion); copyfile(&internal, &alistp); /* add the new material at the end: */ fprintf(alistp.f, "%c %ld mapcontrol: C=do map, R= rotate, char height (72 points/inch)\n", defcolorlistcontrol, (long)deffontsize); fprintf(alistp.f, "%3.1f %4.1f %3.1f amount to move image in x and y (cm) and scale factor\n", defdeltaXcm, defdeltaYcm, defscaleimage); if (*alistp.name != '\0') { if (alistp.f != NULL) alistp.f = freopen(alistp.name, "r", alistp.f); else alistp.f = fopen(alistp.name, "r"); } else rewind(alistp.f); if (alistp.f == NULL) _EscIO2(FileNotFound, alistp.name); RESETBUF(alistp.f, Char); /* ready to start reading again */ if (internal.f != NULL) fclose(internal.f); } /* end module alist.upgradeto598 */ /* begin module alist.upgradeto620 */ Static Void upgradeto620() { /* upgrade the alistp file to version 6.20: add fontsize and the deltaXcm, deltaYcm, and scaleimage parameters */ _TEXT internal; /* a place to hold the old alistp */ internal.f = NULL; *internal.name = '\0'; parameterversion = 6.20; printf("upgrading to version %4.2f ...\n", parameterversion); /* copy alist to internal */ if (*alistp.name != '\0') { if (alistp.f != NULL) alistp.f = freopen(alistp.name, "r", alistp.f); else alistp.f = fopen(alistp.name, "r"); } else rewind(alistp.f); if (alistp.f == NULL) _EscIO2(FileNotFound, alistp.name); RESETBUF(alistp.f, Char); fscanf(alistp.f, "%*[^\n]"); getc(alistp.f); /* skip old parameter version line */ if (*internal.name != '\0') { if (internal.f != NULL) internal.f = freopen(internal.name, "w", internal.f); else internal.f = fopen(internal.name, "w"); } else { if (internal.f != NULL) rewind(internal.f); else internal.f = tmpfile(); } if (internal.f == NULL) _EscIO2(FileNotFound, internal.name); SETUPBUF(internal.f, Char); copyfile(&alistp, &internal); /* copy internal to alist */ if (*internal.name != '\0') { if (internal.f != NULL) internal.f = freopen(internal.name, "r", internal.f); else internal.f = fopen(internal.name, "r"); } else rewind(internal.f); if (internal.f == NULL) _EscIO2(FileNotFound, internal.name); RESETBUF(internal.f, Char); if (*alistp.name != '\0') { if (alistp.f != NULL) alistp.f = freopen(alistp.name, "w", alistp.f); else alistp.f = fopen(alistp.name, "w"); } else { if (alistp.f != NULL) rewind(alistp.f); else alistp.f = tmpfile(); } if (alistp.f == NULL) _EscIO2(FileNotFound, alistp.name); SETUPBUF(alistp.f, Char); fprintf(alistp.f, "%4.2f version of alistp that this parameter file is designed for.\n", parameterversion); copyfile(&internal, &alistp); /* add the new material at the end: */ fprintf(alistp.f, "h headercontrol: h(eader); 0: no header, no numbar; else numbar\n"); if (*alistp.name != '\0') { if (alistp.f != NULL) alistp.f = freopen(alistp.name, "r", alistp.f); else alistp.f = fopen(alistp.name, "r"); } else rewind(alistp.f); if (alistp.f == NULL) _EscIO2(FileNotFound, alistp.name); RESETBUF(alistp.f, Char); /* ready to start reading again */ if (internal.f != NULL) fclose(internal.f); } /* end module alist.upgradeto620 */ /* begin module alist.upgradeparameters */ Static Void upgradeparameters(alistp) _TEXT *alistp; { /* make sure that the parameters are the latest spiffy version */ fscanf(alistp->f, "%lg%*[^\n]", ¶meterversion); getc(alistp->f); if (parameterversion >= updateversion) return; printf("\007You have an old parameter file, version %4.2f!\n", parameterversion); if (parameterversion < 5.96) upgradeto596(); if (*alistp->name != '\0') { if (alistp->f != NULL) alistp->f = freopen(alistp->name, "r", alistp->f); else alistp->f = fopen(alistp->name, "r"); } else rewind(alistp->f); if (alistp->f == NULL) _EscIO2(FileNotFound, alistp->name); RESETBUF(alistp->f, Char); fscanf(alistp->f, "%lg%*[^\n]", ¶meterversion); getc(alistp->f); if (parameterversion < 5.98) upgradeto598(); if (*alistp->name != '\0') { if (alistp->f != NULL) alistp->f = freopen(alistp->name, "r", alistp->f); else alistp->f = fopen(alistp->name, "r"); } else rewind(alistp->f); if (alistp->f == NULL) _EscIO2(FileNotFound, alistp->name); RESETBUF(alistp->f, Char); fscanf(alistp->f, "%lg%*[^\n]", ¶meterversion); getc(alistp->f); if (parameterversion < 6.18) upgradeto620(); if (*alistp->name != '\0') { if (alistp->f != NULL) alistp->f = freopen(alistp->name, "r", alistp->f); else alistp->f = fopen(alistp->name, "r"); } else rewind(alistp->f); if (alistp->f == NULL) _EscIO2(FileNotFound, alistp->name); RESETBUF(alistp->f, Char); fscanf(alistp->f, "%lg%*[^\n]", ¶meterversion); getc(alistp->f); if (parameterversion < updateversion) { printf("Sorry! I am unable to fully upgrade your parameter file\n"); printf("from version %4.2f to version %4.2f!\n", parameterversion, updateversion); printf("Start from a fresh copy or edit this one.\n"); halt(); } else printf("... upgrade successful!\n"); printf("See this page for the new documentation:\n"); printf("http://www.lecb.ncifcrf.gov/~toms/delila/alist.html\n"); } /* Local variables for readparameters: */ struct LOC_readparameters { boolean checkout; /* if true, all variable values are ok */ } ; Local Void cn(LINK) struct LOC_readparameters *LINK; { /* short version of call to check number */ LINK->checkout = checknumber(&alistp); if (!LINK->checkout) /* avoid snowballing */ halt(); } /* end module alist.upgradeparameters */ /* begin module alist.readparameters */ Static Void readparameters() { /* read the parameters */ struct LOC_readparameters V; /* predefine all the parameters so the parameter file can have some missing - this probably should be removed ... */ fromdo = fromparam; todo = toparam; userrange = false; displaylevel = ' '; usefullname = ' '; paging = ' '; alignmenttype = 'i'; column = 6; columnwid = 6; columndec = 2; edgecontrol = 'p'; fontsize = deffontsize; deltaXcm = defdeltaXcm; deltaYcm = defdeltaYcm; scaleimage = defscaleimage; colorlistcontrol = ' '; mapcontrol = false; headercontrol = 'h'; /* read parameters */ if (*alistp.name != '\0') { if (alistp.f != NULL) alistp.f = freopen(alistp.name, "r", alistp.f); else alistp.f = fopen(alistp.name, "r"); } else rewind(alistp.f); if (alistp.f == NULL) _EscIO2(FileNotFound, alistp.name); RESETBUF(alistp.f, Char); if (BUFEOF(alistp.f)) return; upgradeparameters(&alistp); fscanf(alistp.f, "%ld%ld%*[^\n]", &fromdo, &todo); getc(alistp.f); if (fromdo > todo) { printf("from position (%ld) must be less than or equal to to position (%ld)\n", fromdo, todo); halt(); } userrange = true; if (!BUFEOF(alistp.f)) { fscanf(alistp.f, "%c%c%*[^\n]", &displaylevel, &usefullname); getc(alistp.f); if (displaylevel == '\n') displaylevel = ' '; if (usefullname == '\n') usefullname = ' '; } if (!BUFEOF(alistp.f)) { fscanf(alistp.f, "%c%*[^\n]", &paging); getc(alistp.f); if (paging == '\n') paging = ' '; } if (!BUFEOF(alistp.f)) { fscanf(alistp.f, "%c%*[^\n]", &alignmenttype); getc(alistp.f); if (alignmenttype == '\n') alignmenttype = ' '; if (alignmenttype != 'b' && alignmenttype != 'i' && alignmenttype != 'f') { printf("alignment type must be f, b, or i\n"); halt(); } } if (BUFEOF(alistp.f)) { printf("you are missing parameter columntoread etc of alistp!\n"); halt(); } cn(&V); fscanf(alistp.f, "%ld%ld%ld%*[^\n]", &columntoread, &columnwid, &columndec); getc(alistp.f); if (BUFEOF(alistp.f)) { printf("you are missing parameter edgecontrol etc of alistp!\n"); halt(); } edgecontrol = getc(alistp.f); if (edgecontrol == '\n') edgecontrol = ' '; if (edgecontrol != 'p') fscanf(alistp.f, "%lg%lg%lg%lg", &edgeleft, &edgeright, &edgelow, &edgehigh); fscanf(alistp.f, "%*[^\n]"); getc(alistp.f); if (BUFEOF(alistp.f)) { printf("you are missing parameter fontsize etc of alistp!\n"); halt(); } colorlistcontrol = getc(alistp.f); if (colorlistcontrol == '\n') colorlistcontrol = ' '; if (colorlistcontrol == 'R' || colorlistcontrol == 'C') { mapcontrol = true; cn(&V); fscanf(alistp.f, "%ld%*[^\n]", &fontsize); getc(alistp.f); } else { fscanf(alistp.f, "%*[^\n]"); getc(alistp.f); mapcontrol = false; } cn(&V); fscanf(alistp.f, "%lg", &deltaXcm); cn(&V); fscanf(alistp.f, "%lg", &deltaYcm); cn(&V); fscanf(alistp.f, "%lg%*[^\n]", &scaleimage); getc(alistp.f); fscanf(alistp.f, "%c%*[^\n]", &headercontrol); getc(alistp.f); if (headercontrol == '\n') headercontrol = ' '; } /* end module alist.readparameters */ /******************************************************************************/ /******************************************************************************/ /******************************************************************************/ main(argc, argv) int argc; Char *argv[]; { line *WITH; long FORLIM; PASCAL_MAIN(argc, argv); if (setjmp(_JL1)) goto _L1; colors.f = NULL; strcpy(colors.name, "colors"); clist.f = NULL; strcpy(clist.name, "clist"); list.f = NULL; strcpy(list.name, "list"); avalues.f = NULL; strcpy(avalues.name, "avalues"); namelist.f = NULL; strcpy(namelist.name, "namelist"); namebook.f = NULL; strcpy(namebook.name, "namebook"); alistp.f = NULL; strcpy(alistp.name, "alistp"); book.f = NULL; strcpy(book.name, "book"); inst.f = NULL; strcpy(inst.name, "inst"); printf("alist %4.2f\n", version); readparameters(); /* conversion factor from cm to points */ cmfactor = 72 / 2.54; /* (72 points / inch) / (2.54 cm per inch) */ if (*list.name != '\0') { if (list.f != NULL) list.f = freopen(list.name, "w", list.f); else list.f = fopen(list.name, "w"); } else { if (list.f != NULL) rewind(list.f); else list.f = tmpfile(); } if (list.f == NULL) _EscIO2(FileNotFound, list.name); SETUPBUF(list.f, Char); if (*clist.name != '\0') { if (clist.f != NULL) clist.f = freopen(clist.name, "w", clist.f); else clist.f = fopen(clist.name, "w"); } else { if (clist.f != NULL) rewind(clist.f); else clist.f = tmpfile(); } if (clist.f == NULL) _EscIO2(FileNotFound, clist.name); SETUPBUF(clist.f, Char); linenumber = 0; if (headercontrol == 'h') { fprintf(list.f, "alist %4.2f, aligned listing of book:\n", version); linenumber++; splitbooktitle(&book, &list); linenumber += 2; /* the split makes two lines! */ } /* this test must be done before the call to startpostscript! */ clinenumber = 0; if (headercontrol == 'h' || headercontrol != '0') headerclinenumber = headerclines; else headerclinenumber = 0; pagenumber = 1; cpagenumber = 1; /* get the column name */ readcolumnname(&avalues); /* start reading the inst file */ if (*inst.name != '\0') { if (inst.f != NULL) inst.f = freopen(inst.name, "r", inst.f); else inst.f = fopen(inst.name, "r"); } else rewind(inst.f); if (inst.f == NULL) _EscIO2(FileNotFound, inst.name); RESETBUF(inst.f, Char); if (BUFEOF(inst.f)) { if (alignmenttype == 'i') { printf("forcing alignment to be on book because there are no instructions\n"); alignmenttype = 'b'; } } /* start reading the book file */ apiece = (piece *)Malloc(sizeof(piece)); brinit(&book, &theline); if (displaylevel == 'p') maxname(&book, theline, 'p', &namewidth, &list, &linenumber, &org, &orgchange, &orgopen, &chr, &chrchange, &chropen, &pie, &piechange, &pieopen); else maxname(&namebook, theline, 'g', &namewidth, &list, &linenumber, &org, &orgchange, &orgopen, &chr, &chrchange, &chropen, &pie, &piechange, &pieopen); if (*namebook.name != '\0') { if (namebook.f != NULL) namebook.f = freopen(namebook.name, "r", namebook.f); else namebook.f = fopen(namebook.name, "r"); } else rewind(namebook.f); if (namebook.f == NULL) _EscIO2(FileNotFound, namebook.name); RESETBUF(namebook.f, Char); orgchange = false; chrchange = false; piechange = false; orgopen = false; chropen = false; pieopen = false; maxnamelist(&namelist, &namelistwidth); if (*namelist.name != '\0') { if (namelist.f != NULL) namelist.f = freopen(namelist.name, "r", namelist.f); else namelist.f = fopen(namelist.name, "r"); } else rewind(namelist.f); if (namelist.f == NULL) _EscIO2(FileNotFound, namelist.name); RESETBUF(namelist.f, Char); maxfullnamewidth(&book, theline, &fullnamewidth); brinit(&book, &theline); getpositions(&inst, &book, &positionwidth, &numberwidth, &sequences, alignmenttype); printf("%ld sequences in the book\n", sequences); maxminalignment(&inst, &book, &theline, &fromparam, &toparam, alignmenttype); printf("available range: %ld %ld\n", fromparam, toparam); programname.letters[0] = 'a'; programname.letters[1] = 'l'; programname.letters[2] = 'i'; programname.letters[3] = 's'; programname.letters[4] = 't'; programname.length = 5; startpostscript(&clist, &colors, programname, deltaXcm, deltaYcm, scaleimage, defaultllx, defaultlly, defaulturx, defaultury, fromdo, todo, sequences, cmfactor, headerclinenumber); fprintf(clist.f, "startpage\n"); if (headercontrol == 'h') { fprintf(clist.f, "(alist %4.2f, aligned listing of book: ) sn", version); noheader(&clist); clinenumber++; /* copy the book title to the clist on two lines: */ putc('(', clist.f); copytocomma(&book, &clist); copytocomma(&book, &clist); fprintf(clist.f, ") sn"); noheader(&clist); clinenumber++; putc('(', clist.f); putc(' ', clist.f); /* nifty extra space at start aligns things */ copynoreturn(&book, &clist); fprintf(clist.f, ") sn"); noheader(&clist); clinenumber++; noheader(&clist); printf("alignment by "); fprintf(list.f, "The alignment is by "); switch (alignmenttype) { case 'f': printf("first base\n"); fprintf(list.f, "first base\n"); break; case 'i': printf("delila instructions\n"); fprintf(list.f, "delila instructions\n"); break; case 'b': printf("book coordinates\n"); fprintf(list.f, "book coordinates\n"); break; } linenumber += 2; /* (* It isn't clear to me at the moment what the actual range of the book is in the other cases, so it is best not to report the wrong thing! *) if alignmenttype = 'i' then begin 1997 April 23 - I think it's ok now. */ fprintf(list.f, "The book is from: %ld to %ld\n", fromparam, toparam); linenumber++; fprintf(clist.f, "(The book is from: %ld to %ld) sn", fromparam, toparam); noheader(&clist); clinenumber++; /* end; */ fprintf(list.f, "This alignment is from: %ld to %ld\n\n", fromdo, todo); linenumber += 2; fprintf(clist.f, "(This alignment is from: %ld to %ld) sn", fromdo, todo); noheader(&clist); clinenumber++; /* check that the number of header lines actually written matches the constants at the top of the program. */ /* headerlinenumber := linenumber; if headerlinenumber <> headerlines then begin writeln(output,'program list header problem'); writeln(output,' actual headerlinenumber = ',headerlinenumber:1); writeln(output,' const headerlines = ',headerlines:1); halt; end; headerclinenumber := clinenumber; if headerclinenumber <> headerclines then begin writeln(output,'program clist header problem'); writeln(output,' actual headerclinenumber = ',headerclinenumber:1); writeln(output,' const headerclines = ',headerclines:1); halt; end; 2001 Mar 26: If one turns off piece names this changes - I'm not sure why I put this check in, but it seems unreasonable. Probably some other program depends on the header lines matching? */ } /* else headerclinenumber := headerclines; else headerclinenumber := clinenumber; writeln(output,'>>>> clinenumber = ',clinenumber:1); writeln(output,' actual headerclinenumber = ',headerclinenumber:1); writeln(output,' const headerclines = ',headerclines:1); */ if (headercontrol == 'h' || headercontrol != '0') { showalignment(); cshowalignment(); } while (!BUFEOF(book.f)) { switch (alignmenttype) { case 'i': align(&inst, &book, &theline, &apiece, &length_, &alignedbase); break; case 'b': case 'f': getpiece(&book, &theline, &apiece); /* read in the piece */ length_ = piecelength(apiece); break; } if (BUFEOF(book.f)) break; switch (alignmenttype) { case 'f': /* force alignment on first base */ alignedbase = 1; break; case 'i': /* use the alignedbase from the book */ break; case 'b': /* use the internal book */ alignedbase = pietoint(0L, apiece); break; } fprintf(clist.f, "b\n"); if (usefullname == 'l') { putc('(', clist.f); WITH = apiece->key.hea.fulnam; FORLIM = WITH->length; for (index_ = 1; index_ <= FORLIM; index_++) { putc(WITH->letters[index_-1], list.f); putc(WITH->letters[index_-1], clist.f); } FORLIM = fullnamewidth + 1; /* note the extra blank for padding */ for (index_ = WITH->length + 1; index_ <= FORLIM; index_++) { putc(' ', clist.f); putc(' ', list.f); } fprintf(clist.f, ") show\n"); } if (displaylevel == 'p' || displaylevel == 'c') { if (displaylevel == 'p') { FORLIM = namewidth; for (index_ = 1; index_ <= FORLIM; index_++) putc(apiece->key.hea.keynam.letters[index_-1], list.f); } fprintf(list.f, " %*ld", (int)positionwidth, inttopie(alignedbase, apiece)); putc('(', clist.f); if (displaylevel == 'p') { FORLIM = namewidth; for (index_ = 1; index_ <= FORLIM; index_++) putc(apiece->key.hea.keynam.letters[index_-1], clist.f); } fprintf(clist.f, " %*ld", (int)positionwidth, inttopie(alignedbase, apiece)); fprintf(clist.f, ") s "); } /* writeln(output,'displaylevel is p'); writeln(output,'namewidth = ',namewidth:1); for index := 1 to namewidth do write(output,apiece^.key.hea.keynam.letters[index]); writeln(output,'done'); */ else if (!emptyfile(&namebook)) printname(&namebook, theline, nametype, namewidth, &list, &clist, &org, &orgchange, &orgopen, &chr, &chrchange, &chropen, &pie, &piechange, &pieopen, &linenumber, &clinenumber); if (!emptyfile(&namelist)) { putc(' ', list.f); /* extra blank in front of name */ fprintf(clist.f, "( "); /* extra blank in front of name */ index_ = 0; while (!P_eoln(namelist.f)) { index_++; cnamelist = getc(namelist.f); if (cnamelist == '\n') cnamelist = ' '; putc(cnamelist, list.f); putc(cnamelist, clist.f); } FORLIM = namelistwidth - index_; for (indexfill = 1; indexfill < FORLIM; indexfill++) { putc(' ', list.f); putc(' ', clist.f); } fprintf(clist.f, ") show\n"); fscanf(namelist.f, "%*[^\n]"); getc(namelist.f); } if (displaylevel == 'p' || displaylevel == 'c') { /* give the orientation */ if (apiece->key.piedir == minus) thedirection = '-'; else thedirection = '+'; fprintf(list.f, " %c", thedirection); fprintf(clist.f, "( %c) s\n", thedirection); } if (numbered) fprintf(list.f, " %*ld ", (int)numberwidth, number); else putc(' ', list.f); if (numbered) fprintf(clist.f, "( %*ld ) s\n", (int)numberwidth, number); else fprintf(clist.f, "(%*c) s\n", (int)numberwidth, ' '); column = 0; FORLIM = todo; for (index_ = fromdo; index_ <= FORLIM; index_++) { if (withinalignment(index_, alignedbase, length_)) { b = basetochar(getbase(index_ + alignedbase, apiece)); putc(b, list.f); fprintf(clist.f, " %c", b); } else { putc(' ', list.f); fprintf(clist.f, " e"); } column += 2; /* note: the number in the next line must be divisible by 2 or the lines will never be broken */ if (column % 76 == 0) { putc('\n', clist.f); column = 0; } /* p2c: alist.p, line 4144: * Note: Using % for possibly-negative arguments [317] */ } /* give the avalue column */ if (readvalues) { getcolumnvalue(&avalues, columntoread, &columnvalue); fprintf(list.f, " %*.*f", (int)columnwid, (int)columndec, columnvalue); fprintf(clist.f, " ( %*.*f) b s", (int)columnwid, (int)columndec, columnvalue); } putc('\n', list.f); fprintf(clist.f, " n\n"); linenumber++; clinenumber++; if (paging != 'n') { if (linenumber > cpagelength) { /* modified 2002 apr 19 */ fprintf(list.f, "\f"); pagenumber++; fprintf(list.f, "page %ld\n", pagenumber); linenumber = 2; showalignment(); } /* paging is done to the clist at all times! 2001 Nov 5 - well poo on that!! */ /* 2007 Nov 29 change from > to >= */ if (clinenumber >= cpagelength) { cpagenumber++; /* just at the end of a page make sure that the printer is reset to black printing by the 'b' function */ showpage(&clist); fprintf(clist.f, "startpage"); removeit(&clist); fprintf(clist.f, "(page %ld) sn", cpagenumber); removeit(&clist); clinenumber = 2; clinenumber = 1; /* 2007 Nov 29 */ cshowalignment(); } } clearpiece(&apiece); } if (clinenumber > 2) showpage(&clist); removeit(&clist); /* create end of EPS file */ fprintf(clist.f, "%%%%Trailer\n"); _L1: if (inst.f != NULL) fclose(inst.f); if (book.f != NULL) fclose(book.f); if (alistp.f != NULL) fclose(alistp.f); if (namebook.f != NULL) fclose(namebook.f); if (namelist.f != NULL) fclose(namelist.f); if (avalues.f != NULL) fclose(avalues.f); if (list.f != NULL) fclose(list.f); if (clist.f != NULL) fclose(clist.f); if (colors.f != NULL) fclose(colors.f); exit(EXIT_SUCCESS); } /* alist */ /* End. */