/* Output from p2c 1.21alpha-07.Dec.93, the Pascal-to-C translator */ /* From input file "bk2seq.p" */ #include /* converts a book to a sequence by Mike Stephens modified by Thomas Schneider 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 http://www.ccrnp.ncifcrf.gov/~toms/ module libraries: delman, delmods, prgmods */ /* end of program */ /* begin module version */ #define version 1.13 /* of bk2seq.p 2008 Jul 29 2008 Jul 29, 1.13: upgrade for triggers 2008 Jul 29, 1.12: maximumrange increased in minmaxalignment. 1997 Mar 17, 1.11: functional origin 1992 August 18 */ /* end module version */ /* begin module describe.bk2seq */ /* name bk2seq: takes a book file and makes it a protseq file. synopsis bk2seq(inst: in, book: in, bk2seqp: in, alprop: out, protseq: out, output: out) files inst: delila instructions of the form 'get from 56 -5 to 56 +10;' (This file may be empty, in which case the sequences will be aligned by their 5' ends.) book: the book generated by delila using inst bk2seqp: parameters to control the program. If the file is empty, the protseq format is generated. If the file begins with the letter 'f', fasta format is generated. alprop: parameter file to control the alpro program so that alpro uses the correct alignment coordinates. protseq: the output file, usable by alpro and other programs. output: messages to the user description This program simply takes a file in book format and converts it to protseq format. It was written mainly as an interface between books and those progams such as alpro and align that require protseq format. Fasta format can be used by other programs. documentation none author R. Michael Stephens bugs User defined range is not yet implemented. technical notes symbolsperline is a constant that determines the maximum number of symbols written per line to the protseq. */ /* end module describe.bk2seq */ #define symbolsperline 70 /* the maximum number of symbols written per line to the protseq */ /* begin module book.const */ /* constants needed for book manipulations */ #define dnamax 1024 /* length of dna arrays */ #define namelength 100 /* maximum key name length */ #define linelength 200 /* maximum line readable in book */ /* end module book.const version = 7.73; {of delmod.p 2008 Jul 29} */ /* 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) */ /* module filler.const */ #define fillermax 50 /* the size of the filler array for a string */ /* module filler.const from prgmod.p 4.20 */ /* begin module string.const */ #define maxstring 2000 /* the maximum string */ /* end module string.const version = 4.86; (@ of prgmod.p 2004 Sep 8 */ /* 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]; uchar 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.73; {of delmod.p 2008 Jul 29} */ /* sequence types */ typedef short dnarange; /* p2c: bk2seq.p, line 139: * 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.73; {of delmod.p 2008 Jul 29} */ /* 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 */ /* 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]; /* module filler.type from prgmod.p 4.20 */ /* 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; /* module trigger.type from prgmod.p 4.20 */ Static _TEXT inst; /* the delila instructions required by the align procedures */ Static _TEXT book; /* the book to be aligned */ Static _TEXT bk2seqp; /* control parameters for the bk2seq program */ Static _TEXT alprop; /* control for the alpro program */ Static _TEXT protseq; /* the output of the program */ /* 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 paging; /* defines whether to do pages. If 'n' no pages are done */ Static long index_; /* aligned space index */ Static boolean orgopen; /* used by procedures maxname and printname */ 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 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 */ /* 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; Static jmp_buf _JL1; /* a control variable to allow skipping of un-numbered items in the book */ /* ************************************************************************ */ /* end module book.var version = 7.73; {of delmod.p 2008 Jul 29} */ /* 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.73; {of delmod.p 2008 Jul 29} */ /* 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_ == '\t'); } 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 = 7.73; {of delmod.p 2008 Jul 29} */ /* 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.73; {of delmod.p 2008 Jul 29} */ /* begin module interact.clearstring */ /* begin module clearstring */ Static Void clearstring(ribbon) string *ribbon; { /* empty the string */ long index; /* to the ribbon */ for (index = 0; index < maxstring; index++) ribbon->letters[index] = ' '; ribbon->length = 0; ribbon->current = 0; } /* 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. */ clearstring(ribbon); ribbon->next = NULL; } /* initializestring */ /* end module clearstring version = 4.86; (@ of prgmod.p 2004 Sep 8 */ /* end module interact.clearstring version = 7.73; {of delmod.p 2008 Jul 29} */ /* 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 = 7.73; {of delmod.p 2008 Jul 29} */ /* 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 = 7.73; {of delmod.p 2008 Jul 29} */ /* 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 */ /* end module trigger.proc version = 7.73; {of delmod.p 2008 Jul 29} */ /* 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.73; {of delmod.p 2008 Jul 29} */ /* 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.73; {of delmod.p 2008 Jul 29} */ /* 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.73; {of delmod.p 2008 Jul 29} */ /* 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.73; {of delmod.p 2008 Jul 29} */ /* 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.73; {of delmod.p 2008 Jul 29} */ /* 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.73; {of delmod.p 2008 Jul 29} */ /* 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.73; {of delmod.p 2008 Jul 29} */ /* 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.73; {of delmod.p 2008 Jul 29} */ /* 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.73; {of delmod.p 2008 Jul 29} */ /* 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.73; {of delmod.p 2008 Jul 29} */ /* 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.73; {of delmod.p 2008 Jul 29} */ /* 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.73; {of delmod.p 2008 Jul 29} */ /* 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.73; {of delmod.p 2008 Jul 29} */ /* 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.73; {of delmod.p 2008 Jul 29} */ /* 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.73; {of delmod.p 2008 Jul 29} */ /* 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.73; {of delmod.p 2008 Jul 29} */ /* 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.73; {of delmod.p 2008 Jul 29} */ /* ************************************************************************ */ /* end module package.brpiece version = 7.73; {of delmod.p 2008 Jul 29} */ /* 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.73; {of delmod.p 2008 Jul 29} */ /* ************************************************************************ */ /* end module package.getpiece version = 7.73; {of delmod.p 2008 Jul 29} */ /* 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.73; {of delmod.p 2008 Jul 29} */ /* 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.73; {of delmod.p 2008 Jul 29} */ /* 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: bk2seq.p, line 1391: 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: bk2seq.p, line 1438: 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.73; {of delmod.p 2008 Jul 29} */ /* ************************************************************************ */ /* end module package.align version = 7.73; {of delmod.p 2008 Jul 29} */ /* 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(" WARNING: 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"); /* 2008 Jul 29: remove the halt to allow bk2seq to function. */ /* 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. */ } /* 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.73; {of delmod.p 2008 Jul 29} */ /* 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.73; {of delmod.p 2008 Jul 29} */ /* 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 absolute; /* 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->absolute - LINK->absolute / 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.73; {of delmod.p 2008 Jul 29} */ /* 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 */ 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.absolute = labs(V.number); if (V.absolute < V.place / 10) { V.acharacter = ' '; return V.acharacter; } if (V.absolute >= 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 = 'prgmod 3.96 85 mar 18 tds'; */ /* begin module numbersize */ Static long numbersize(n) long n; { /* calculate amount of space to be reserved for the integer n */ if (n == 0) return 1; else { return ((long)(log((double)labs(n)) / ln10 + epsilon) + 2); /* 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. */ /* the 2 is for the sign and last digit */ } } /* numbersize */ #undef ln10 #undef epsilon /* end module numbersize version = 'prgmod 3.96 85 mar 18 tds'; */ /* begin module numberbar */ 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 spacecount; /* count of spaces */ long number; /* the current number being written */ if (labs(firstnumber) > labs(lastnumber)) *linesused = numbersize(firstnumber); else *linesused = numbersize(lastnumber); 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 = 'prgmod 3.96 85 mar 18 tds'; */ /* ************************************************************************ */ /* end module package.numbar version = 'prgmod 3.96 85 mar 18 tds'; */ /* 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 */ long logplace; /* the log of the digit being looked at */ long spacecount; /* count of spaces */ long number; /* the current number being written */ if (labs(firstnumber) > labs(lastnumber)) *linesused = numbersize(firstnumber); else *linesused = numbersize(lastnumber); for (logplace = *linesused - 1; logplace >= 0; logplace--) { putc('(', afile->f); for (spacecount = 1; spacecount <= spaces; spacecount++) putc(' ', afile->f); for (number = firstnumber; number <= lastnumber; number++) fputc(numberdigit(number, logplace), afile->f); fprintf(afile->f, ") sn\n"); } } /* Local variables for getname: */ struct LOC_getname { _TEXT *namebook; Char *typefound; name *aname; long *theline; Char ch; /* for using the getto procedure */ } ; Local Void obtain(LINK) struct LOC_getname *LINK; { /* obtain the name. */ brname(LINK->namebook, LINK->theline, LINK->aname); *LINK->typefound = LINK->ch; } /* end module pnumberbar */ Static Void getname(namebook_, nametype, typefound_, aname_, orgopen, theline_) _TEXT *namebook_; Char nametype, *typefound_; name *aname_; boolean *orgopen; long *theline_; { /* get to the next name in name book, looking for an organism or the type defined by nametype. orgopen keeps track of the organism. */ /* getname should eventually be replaced by a procedure that reads instructions rather than a book. this procedure is based on getocp. */ struct LOC_getname V; long SET[5]; V.namebook = namebook_; V.typefound = typefound_; V.aname = aname_; V.theline = theline_; *V.typefound = '.'; do { P_addset(P_expset(SET, 0L), 'o'); V.ch = getto(V.namebook, V.theline, P_addset(SET, nametype)); if (V.ch != ' ') { switch (V.ch) { case 'o': *orgopen = !*orgopen; if (*orgopen) obtain(&V); break; case 'g': case 't': case 'p': if (V.ch == nametype) obtain(&V); /* skip the rest of the object: */ V.ch = getto(V.namebook, V.theline, P_addset(P_expset(SET, 0L), V.ch)); break; } } else *V.typefound = V.ch; } while (*V.typefound != nametype && *V.typefound != 'o' && *V.typefound != ' '); } Static Void printname(namebook, nametype, namewidth, tofile, ctofile, orgopen, linenumber, clinenumber, theline) _TEXT *namebook; Char nametype; long namewidth; _TEXT *tofile, *ctofile; boolean *orgopen; long *linenumber, *clinenumber, *theline; { /* 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, nametype, &typefound, &aname, orgopen, theline); 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 != ' '); } /* 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. */ if (c_ == '\\' || c_ == '%' || c_ == ')' || c_ == '(') putc('\\', afile->f); } /* end module makelogo.protectpostscript */ /* 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 */ Static Void themain(inst, book, bk2seqp, alprop, protseq) _TEXT *inst, *book, *bk2seqp, *alprop, *protseq; { long alignpoint; /* point of the sequence that should be the 0 alignment coordinate */ long index; /* a loop control variable */ Char outtype; /* p: protseq format generated, f: fasta format generated */ long theline; /* the line in the book */ Char alignmenttype = 'i'; long FORLIM; /* type of alignment: 'f' means alignment by First internal coordinate base, 'b' means alignment by Book, 'i' means alignment by Instructions. */ printf("bk2seq %4.2f\n", version); if (*alprop->name != '\0') { if (alprop->f != NULL) alprop->f = freopen(alprop->name, "w", alprop->f); else alprop->f = fopen(alprop->name, "w"); } else { if (alprop->f != NULL) rewind(alprop->f); else alprop->f = tmpfile(); } if (alprop->f == NULL) _EscIO2(FileNotFound, alprop->name); SETUPBUF(alprop->f, Char); if (*protseq->name != '\0') { if (protseq->f != NULL) protseq->f = freopen(protseq->name, "w", protseq->f); else protseq->f = fopen(protseq->name, "w"); } else { if (protseq->f != NULL) rewind(protseq->f); else protseq->f = tmpfile(); } if (protseq->f == NULL) _EscIO2(FileNotFound, protseq->name); SETUPBUF(protseq->f, Char); if (*bk2seqp->name != '\0') { if (bk2seqp->f != NULL) bk2seqp->f = freopen(bk2seqp->name, "r", bk2seqp->f); else bk2seqp->f = fopen(bk2seqp->name, "r"); } else rewind(bk2seqp->f); if (bk2seqp->f == NULL) _EscIO2(FileNotFound, bk2seqp->name); RESETBUF(bk2seqp->f, Char); if (BUFEOF(bk2seqp->f)) outtype = 'p'; else outtype = 'f'; apiece = (piece *)Malloc(sizeof(piece)); 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); brinit(book, &theline); if (outtype == 'p') { fprintf(protseq->f, "* bk2seq %4.2f\n", version); fprintf(protseq->f, "* "); } else fprintf(protseq->f, "> bk2seq %4.2f", version); copyaline(book, protseq); 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); maxminalignment(inst, book, &theline, &fromparam, &toparam, alignmenttype); fromdo = fromparam; todo = toparam; userrange = false; if (outtype == 'p') { fprintf(protseq->f, "* The book is from: %ld to %ld\n", fromparam, toparam); fprintf(protseq->f, "* Alist list is from: %ld to %ld\n", fromdo, todo); } alignpoint = 1 - fromparam; if (alignpoint < 1) { printf("WARNING\n"); printf("Something may be wrong with the alignment of the book.\n"); printf("The alignment is outside the pieces.\n"); } fprintf(alprop->f, "%ld alignment point for the alpro program\n", alignpoint); while (!BUFEOF(book->f)) { align(inst, book, &theline, &apiece, &length_, &alignedbase); if (BUFEOF(book->f)) break; if (outtype == 'p') fprintf(protseq->f, "* "); else fprintf(protseq->f, "> "); /* for index := 1 to namelength do write(protseq,apiece^.key.hea.keynam.letters[index]); */ index = 1; while (apiece->key.hea.keynam.letters[index-1] != ' ' && index < namelength) { putc(apiece->key.hea.keynam.letters[index-1], protseq->f); index++; } fprintf(protseq->f, " %5ld", inttopie(alignedbase, apiece)); if (numbered) fprintf(protseq->f, " %5ld ", number); putc('\n', protseq->f); column = 0; FORLIM = todo; for (index = fromdo; index <= FORLIM; index++) { if (withinalignment(index, alignedbase, length_)) { b = basetochar(getbase(index + alignedbase, apiece)); putc(b, protseq->f); } else putc('-', protseq->f); column++; if (column % symbolsperline == 0) { /* p2c: bk2seq.p, line 1948: * Note: Using % for possibly-negative arguments [317] */ column = 0; putc('\n', protseq->f); } } if (outtype == 'p') putc('.', protseq->f); /* fasta format does not have an end of sequence mark! */ putc('\n', protseq->f); clearpiece(&apiece); } } main(argc, argv) int argc; Char *argv[]; { PASCAL_MAIN(argc, argv); if (setjmp(_JL1)) goto _L1; protseq.f = NULL; strcpy(protseq.name, "protseq"); alprop.f = NULL; strcpy(alprop.name, "alprop"); bk2seqp.f = NULL; strcpy(bk2seqp.name, "bk2seqp"); book.f = NULL; strcpy(book.name, "book"); inst.f = NULL; strcpy(inst.name, "inst"); themain(&inst, &book, &bk2seqp, &alprop, &protseq); _L1: if (inst.f != NULL) fclose(inst.f); if (book.f != NULL) fclose(book.f); if (bk2seqp.f != NULL) fclose(bk2seqp.f); if (alprop.f != NULL) fclose(alprop.f); if (protseq.f != NULL) fclose(protseq.f); exit(EXIT_SUCCESS); } /* bk2seq */ /* End. */