From bronze!news.cs.indiana.edu!spool.mu.edu!sdd.hp.com!swrinde!gatech!europa.asd.contel.com!paladin.american.edu!auvm!BCHM1.ACLCB.PURDUE.EDU!WESTERM Fri Nov 8 12:15:19 EST 1991 Article: 314 of bit.listserv.info-gcg Path: bronze!news.cs.indiana.edu!spool.mu.edu!sdd.hp.com!swrinde!gatech!europa.asd.contel.com!paladin.american.edu!auvm!BCHM1.ACLCB.PURDUE.EDU!WESTERM From: westerm@BCHM1.ACLCB.PURDUE.EDU (Rick Westerman) Newsgroups: bit.listserv.info-gcg Subject: PRETTYBOX v1.1 Message-ID: <0095153a.9d07ac60.20989@aclcb.purdue.edu> Date: 8 Nov 91 15:01:40 GMT Article-I.D.: aclcb.0095153a.9d07ac60.20989 Sender: "INFO-GCG: GCG Genetics Software Discussion" Reply-To: westerm@aclcb.purdue.edu Lines: 1198 Comments: Gated by NETNEWS@AUVM.AMERICAN.EDU -------- Cut here for README.DOC ----------- This is version 1.1, Oct. 1991 of PrettyBox. See below for details. The enclosed program, PrettyBox, is fully GCG-compatible and is designed to be a complementry program to Pretty. Like Pretty, it will print out pre-aligned sequences and, optionally, a consensus sequence; it does not do the alignments. Unlike Pretty, the printout consists of shaded boxes around each residue, much like those found in journal articles. The printing can *only* be done on Postscript-compatible printers, the other GCG output devices are not supported. Both MSF and "file of sequence files" format input files are accepted. Output is normally to "PlotPort". The output can be redirected to a file via the "/OUTfile=file.name" command line option. The program has been written from scratch, e.g., there is no GCG code inside it, thus it can be freely distributed. It does make extensive use of the GCG function library and cannot be run on systems that do not support GCG. The program has only been tested on version 7 of the GCG package. There are 4 files enclosed in this posting. You should edit this posting and create 4 different files from it as follows: README.DOC -- this file PRETTYBOX.TXT -- begginning text, put in GENRUNDOC PRETTYBOX.CMD -- options to the program, put in GENRUNDOC PRETTYBOX.FOR -- the program, compile via FOR PRETTYBOX, link via GENLINK PRETTYBOX, install via putting a symbol in your SITELOGICALS.COM file, e.g.: PRETTYBOX :== $DISK:[DIR]PRETTYBOX Don't forget to make everything world readable or however you setup your system protections. ************* 10-Sep-1991: Beta release 1.0 20-Oct-1991: Version 1.1 1) Fixed right-hand print bug that caused printout to run over edge. 2) Fixed rare bug that caused an extra space between the sequence and the right-hand numbers when the sequence ended on the edge. 3) Fixed bug (feature?) that caused plurality to be exactly 1/2 of the number of sequences; now it is 1/2 plus a bit. 4) Added asking for consensus plurality. 5) Added option for fatter (bolder) letters. 6) Added for a region of interest via *.mrk file. 7) Made 10 point font the default size; it was 12. 8) Added option to change spaces between blocks; default = 1. Thanks: To Kay Hoffmann (khofmann@biolan.uni-koeln.de)) for her valuable suggestions. Kay has written another box shading program (BOXSHADE) which is not fully GCG compatible but does read in GCG files amoung other formats. It produces output to a variety of devices in addition to Postscript output. Other programs: In the Unsupported portion of GCG release 7, the Pretty program has been converted by Peter Rice of EMBL to draw boxes around bases; the program is called PrettyPlot. Note that drawing boxes is different than box shading. Known problems: Still no manual. You can see the options to the program via the normal /CHECK command line option. I didn't get many comments on the Beta release. I would appreciate any comments on program bugs, the utility of the program, suggested improvements to the program, or even if you are running the program. Please send email to the address below. ************* Rick Westerman System Manager of the AIDS Center Laboratory westerm@aclcb.purdue.edu for Computational Biochemistry (ACLCB), BCHM (317) 494-0505 bldg., Purdue University, W. Lafayette, IN 47907 -------- Cut here for PRETTYBOX.TXT -- install in GENRUNDOC ----------- ^*PrettyBox\* displays multiple sequence alignments as shaded boxes in Postscript format (e.g., the output file must be printed and/or displayed on a Postscript-compatible device). PrettyBox will optionally calculates a consensus sequence. The program does not create the alignment; it simply displays it. -------- Cut here for PRETTYBOX.CMD -- install in GENRUNDOC ----------- .tp 6 Syntax: $ PRETTYBOX [/INfile=]@PrettyBox.Fil /Default Required Parameters: /BEGin=1 /END=349 Range of interest /ORIentation=Land Which direction the printing will be, Landscape or Portrait /NUMbering=Right Print sequence numbering to Right side, Top side, or None /[NO]CONsensus Displays a consensus sequence .tp 4 Local Data Files: /DATa=PrettyDNA.Cmp Consensus comparison table for Nucleotides /DATa=PrettyPep.Cmp Consensus comparison table for Proteins /INITialize=PrettyBox.Init Local command line initialization file PrettyBox.MRK If present, describes regions to do boxing .tp 10 Optional Parameters: /OUTput=file.name Normally output goes to the PlotPort (postscript-compatible) /PROtein Insists that your sequences are proteins, not nucleic acids /SIMilar Consider similarity in generating a consensus; most useful with proteins /[No]OFFset If to offset the consensus line from the other sequences /IDEntity Boxes only positions of unanimous agreement /CASe Shows positions agreeing with the consensus in upper case, other postions are lower case /THReshold=1.0 Sets minimum comparison value for symbol to vote in the consensus /PLUrality=2.0 Defines the minimum number of votes for a consensus to exist /LINesize=50 Sets the number of residues per line /BLOcksize=10 Sets the number of residues per block /SPAcing=1 Sets spaces between blocks /FONtsize=10 Font size in terms of postscript numbers /XMArgin=20 Left/right margins in postscript units /YMArgin=20 Top/bottom margins in postscript units /[No]HEAder If to print the header /BLAnklines=2 Blank lines between each set of sequences /[NO]ASKstart If to ask about the starting numbers for each sequence /[NO]FAT If to use fat (bold) lettering /SEQName=Partial If the names of the sequences should be Partial (don't include the file name, good for Pileup files), Full, or None. /PAIr=1.5,1.0,0.5 Thresholds for identical, similar, and somewhat-similar pair-wise matching. Protein defaults are: 1.5, 1.0, 0.5. Nucleic acid defaults are: 1.0, 1.0, 1.0. /COLor=B,L,P,W What color identical, similar, somewhat-similar, and non- matching residues will have. The colors are: Black, Dark, Light, Pale, White. /DENsity=Fine Density of printing, this can be either Rough or Fine; Rough may xerox better. This works with Dark, Light, and Pale colors only. -------- Cut here for PRETTYBOX.FOR -- compile, link, and install ----------- !**** PRETTYBOX ************************************************************* !* !* A program to take multiple pre-aligned GCG sequences and write them to !* a Postscript-compatible shaded box format. !* !* The program runs with version 7 of the GCG package. It may run with !* version 6, but I haven't tested it. !* !* Created Sep-1991 by: !* !* Rick Westerman System Manager of the AIDS Center Laboratory !* westerm@aclcb.purdue.edu for Computational Biochemistry (ACLCB), BCHM !* (317) 494-0505 bldg., Purdue University, W. Lafayette, IN !* 47907 !* !* Modification history !* !* Version 1.1, Oct, 1991, RPW !* !* 1) Fixed right-hand print bug that caused printout to run over edge. !* 2) Fixed rare bug that caused an extra space between the sequence !* and the right-hand numbers when the sequence ended on the edge. !* 3) Fixed bug (feature?) that caused plurality to be exactly 1/2 of !* the number of sequences; now it is 1/2 plus a bit. !* 4) Added asking for consensus plurality. !* 5) Added option for fatter (bolder) letters. !* 6) Added for a region of interest via *.mrk file. !* 7) Made 10 point font the default size; it was 12. !* 8) Added option to change spaces between blocks; default = 1. !* !* Thanks: !* To Kay Hoffmann (khofmann@biolan.uni-koeln.de)) for her valuable !* suggestions. Kay has written another box shading program (BOXSHADE) !* which is not fully GCG compatible but does read in GCG files, amoung !* other formats. It produces output to a variety of devices in !* addition to Postscript output. !* !* Other programs: !* !* In the Unsupported portion of GCG release 7, the Pretty program !* has been converted by Peter Rice of EMBL to draw boxes around !* bases; the program is called PrettyPlot. Note that drawing boxes !* is different than box shading. !* !***************************************************************************** Program PrettyBox ! ! ... define variables ! Implicit None Include 'GenInclude:Sequence.Inc' ! ... normal variables Parameter SEQUENCENUM = 100 ! number of possible sequences Parameter SEQUENCELEN = 2 000 000 ! place to hold all the seq info Character Scratch(256),C ! scratch, or temporary, string Character Scr2(256) ! temporary string Logical Answer, Wer ! temporary logical Integer I, J, K, L, M ! temporary integer for indexing Logical Error ! if an error occurs Real A,B,AA ! temporary real Integer Stream /1/ ! stream id for next file Character Residues(SEQUENCELEN) ! holds all the sequences Integer Start(SEQUENCENUM) ! starting position in Residues for ! each sequence Integer Length(SEQUENCENUM) ! length of each sequence Real Weight(SEQUENCENUM) ! weight of each sequence Character Name(256,SEQUENCENUM) ! file name of each sequence Integer Used(SEQUENCENUM) ! actual residues used in a sequence Integer MaxNameLen ! maximum length of the file names Integer MaxLen ! maximum seq. length of those read in Integer Number ! number of sequences read in Integer Current ! current position in Residues Integer InFile ! file pointer Record /Sequence/ SQ ! current sequence record Real XDim, YDim ! X and Y maximum postscript dimensions Real Alpha(32) ! count of weighted letters - consensus Real CmpTable(32,32) ! comparison table Integer Value(SEQUENCENUM) ! final value of comparison Integer Out ! output file id Character OutFName(256) ! output file name (PlotPort) Character Title(256) ! title, or header, of the plot Integer XBeginName,XBegin,XEnd ! unit co-ordinates Integer YBegin, YEnd, YBase ! unit co-ordinates Integer HeaderBegin ! header beginning unit co-ordinates Integer XCur, YCur ! current co-ordinates Integer Page, Count, Many ! used in keeping track of pages & lines Integer ColorIndex(4) ! colors used Character ColorNames(10,5) ! names of the colors used Real Fudge /0.6/ ! percent of spacing for normal print Integer Dat ! data file id Logical Jump ! if there is a blank in right column Real MaxCons ! best match to consensus Real Largest ! largest entry used in the CmpTable Logical Fat ! if to use fat (bold) letters Logical AskStart ! if to ask about starting numbers Integer FromTo(2,100) ! regions of interest via *.MRK file ! ... parameters Integer Begin, End, FontSize, LineSize, BlockSize Integer XMargin, YMargin, Spaces, Blanklines Real Threshold, Plurality, Pair(4) Character Orientation, SeqName, Density, Numbering Character Color(4), WildFName(256) Logical Protein, Consensus, Identity, Case, Header Logical Interact, Offset, Similarity ! ... routines Logical CLGetStr, CLNoInteract, CLRetBool, CLGetStrList Logical SQRead, ReOpenF, NextFile, CLGetWildFName, OpenF Logical OpenP, CLGetParam, CLGetBool, GetDataFile Logical StrToReal, CLFileInit, GetYesNo Integer CLRetInt, GetString, NewFileType, Str_Len, GetIntNum Integer StrToPostScript, StrShift, StrConcat, StrToUpper Integer AlphaToNum, GetMenu, ReadCmpTab, StrCompare Character NumToAlpha, ChToLower, ChToUpper Real CLRetReal, GetRealNum ! ! ... start the program ! Call Doc('GenRunDoc:PrettyBox.Txt') Interact = .not.CLNoInteract() Call StrCopy(Scratch,'PrettyBox.Init') Answer = CLFileInit(Scratch) Call CLComCheck('GenRunDoc:PrettyBox.Cmd') ! ... open output file -- normally the PlotPort Answer = CLGetParam('OUTput',2,OutFName) If (.not.Answer) Call StrCopy(OutFName,'PlotPort') Answer = OpenF(Out,OutFName,'w') If (.not.Answer) Call WriteF(' PRETTYBOX cannot open %s\n\b\s', & OutFName) ! ... set defaults for non-essential parameters; get command line FontSize = CLRetInt( 'FONtsize', 6, 30, 10) BlockSize = CLRetInt( 'BLOcksize', 1, 150, 10) Threshold = CLRetReal('THReshold', 0.0, 900.0, 0.0) XMargin = CLRetInt('XMArgin', -900, 900, 20) YMargin = CLRetInt('YMArgin', -900, 900, 20) Blanklines= CLRetInt('BLAnklines',0,5,2) Spaces = CLRetInt('SPAcing',0,5,1) Protein = CLRetBool('PROtein') Identity = CLRetBool('IDEntity') Case = CLRetBool('CASe') AskStart = CLRetBool('ASKstart') Fat = CLRetBool('FAT') Similarity= CLRetBool('SIMilarity') Header = .true. Answer = CLGetBool('HEAder',Header) Offset = .true. Answer = CLGetBool('OFFset',Offset) Numbering = 'R' Answer = CLGetStr( 'NUMbering',Scratch) I = StrToUpper(Scratch) If (Answer) Numbering = Scratch(1) SeqName = 'P' Answer = CLGetStr( 'SEQName',Scratch) I = StrToUpper(Scratch) If (Answer) SeqName = Scratch(1) Density = 'F' Answer = CLGetStr( 'Density',Scratch) I = StrToUpper(Scratch) If (Answer) Density = Scratch(1) Color(1) = 'B' ! color for identical residues (black) Color(2) = 'L' ! color for similar residues (light) Color(3) = 'P' ! color for somewhat-similar residues (pale) Color(4) = 'W' ! color for non-matching residues (white) Do I = 1,4 Answer = CLGetStrList('COLor',Scratch,I) J = StrToUpper(Scratch) If (Answer) Color(I) = Scratch(1) End Do Call StrCopy(ColorNames(1,1),'black') Call StrCopy(ColorNames(1,2),'dark') Call StrCopy(ColorNames(1,3),'light') Call StrCopy(ColorNames(1,4),'pale') Call StrCopy(ColorNames(1,5),'white') Do I = 1,4 If (Color(I) .eq. 'B') ColorIndex(I) = 1 If (Color(I) .eq. 'D') ColorIndex(I) = 2 If (Color(I) .eq. 'L') ColorIndex(I) = 3 If (Color(I) .eq. 'P') ColorIndex(I) = 4 If (Color(I) .eq. 'W') ColorIndex(I) = 5 End Do ! ... set defaults for essential parameters and then, if allowed, ask ! the user about them MaxLen = 0 ! ....... get sequence files Answer = CLGetWildFName('INfile', 1, WildFName) If (Answer) Goto 55 50 I = 0 If (Interact) then Call WriteF('\n PRETTYBOX what sequences ? ') I = GetString(WildFName) End If If (I .le. 0) Stop ' ' 55 If (WildFName(1) .eq. Char(0)) then Call WriteF('\n *** ERROR,'// & ' PRETTYBOX requires at least one input file ***\n\b') Goto 50 End If Number = 0 Current = 0 Do While ( NextFile(Stream, WildFName, Name(1,Number+1) )) If (Number .ge. SEQUENCENUM) then Call WriteF('\n Too many sequences. PRETTYBOX will'// & ' use only %d sequences.\n',SEQUENCENUM - 1) Goto 100 End If Number = Number + 1 Error = .false. If (.not.ReOpenF(InFile, Name(1,Number), 'rdb')) then Error = .true. Goto 60 Else If (SQRead(Infile, SQ)) then Call BaseSpec(Name(1,Number)) Length(Number) = SQ.Len If (Interact) Call WriteF('%30s, len: %d\n', & Name(1,Number), Length(Number)) If (Length(Number) .gt. MaxLen) & MaxLen = Length(Number) Else Error = .true. Goto 60 End If End If ! ........... check for enough room in residue buffer, include possible ! consensus sequence I = Current + Length(Number) + MaxLen If (I .ge. SEQUENCELEN) then Call WriteF('\n Not enough room in buffer. PRETTYBOX'// & ' will use only %d sequences.\n',SEQUENCENUM - 1) Number = Number - 1 Goto 100 End If Start(Number) = Current - 1 ! decrement so index ! such as j=1,end works Weight(Number) = SQ.Weight Call StrCopy(Residues(Current), SQ.seq) Current = Current + Length(Number) + 1 60 If (Error) then Call WriteF('\n Cannot read %s.\n',Name(1,Number)) Number = Number - 1 End If End Do ! ........... end of reading in sequences ! ........... check to see if any sequences were read in 100 If (Number .le. 0) then Call WriteF('\n *** No files in %s ***\b\n',WildFName) Goto 50 End If ! ....... end of getting sequence file ! ....... get the proper data file If (SQ.Type .eq. SQPROTEIN) Protein = .true. If (Protein) then Call StrCopy(Scratch,'PrettyPEP.Cmp') Else Call StrCopy(Scratch,'PrettyDNA.Cmp') End If Answer = GetDataFile(Dat,Scratch) If (Answer) then Call WriteF('Can not open data file "%s"\n',Scratch) Else I = ReadCmpTab(Dat,CmpTable) End If ! ....... now get begin and end residue numbers If (Interact) Call WriteF('\n') Call GetRange(Begin, End, MaxLen) ! ....... get orientation Orientation = 'L' Answer = CLGetStr( 'ORIentation',Scratch) I = StrToUpper(Scratch) If (Answer) Orientation = Scratch(1) If ((Interact) .and. (.not.Answer)) then Call WriteF('\n Orient output as Landscape or Portrait'// & '(* %c *) ? ',Orientation) I = GetMenu(Scratch) J = StrToUpper(Scratch) If (I .ge. 1) Orientation = Scratch(1) End If If ((Orientation .ne. 'L') .and. (Orientation .ne. 'P')) & Orientation = 'L' ! ....... consensus & numbering options Consensus = .false. Answer = CLGetBool('CONsensus',consensus) If (.not.Answer .and. Interact) then Call WriteF('\n Display a consensus (* No *) ? ') Answer = GetYesNo(Consensus) End If ! find plurality A = 0.0 Do I = 1, Number If (Weight(I) .gt. Threshold) A = A + Weight(I) End Do A = A / 2.0 + 0.1 ! default is 1/2 the total weight plus a bit Plurality = CLRetReal('PLUrality', 0.0, 900.0, A) If (Interact .and. Consensus) then Call WriteF('\n Find consensus to what plurality (* %5.1f *) ? ', & Plurality) Plurality = GetRealNum('Plurality',0.0, 900.0, Plurality) End If ! get numbering scheme Numbering = 'R' Answer = CLGetStr( 'NUMbering',Scratch) I = StrToUpper(Scratch) If (Answer) Numbering = Scratch(1) If ((Interact) .and. (.not.Answer)) then Call WriteF('\n Do numbering on Right side, Top side, or '// & 'None (* %c *) ? ',Numbering) I = GetMenu(Scratch) J = StrToUpper(Scratch) If (I .ge. 1) Numbering = Scratch(1) End If If ((Numbering .ne. 'T') .and. (Numbering .ne. 'N')) & Numbering = 'R' ! .......... add consensus name if needed If ((Consensus) .and. (SeqName .ne. 'N')) then Call StrCopy(Name(1,Number+1),'Consensus ') Else Call StrCopy(Name(1,Number+1),' ') End If ! .......... correct file names for what user wants displayed Do I = 1, Number If (SeqName .ne. 'F') then ! leave full name alone If (SeqName .eq. 'N') then ! zap no name Call StrCopy(Name(1,I), ' ') Else ! manipulate partial (default) J = NewFileType(Name(1,I), ' ') End If End If Call StrConcat(Name(1,I),' ') ! add a space to everything End Do ! ........... correct for postscript, find max length, and right justify MaxNameLen = 0 Do I = 1, Number+1 J = StrToPostScript(Name(1,I)) If (J .gt. MaxNameLen) MaxNameLen = J End Do Do I = 1, Number+1 J = Str_Len(Name(1,I)) J = MaxNameLen - J K = StrShift(Name(1,I),J) End Do ! ....... get range of interest via *.MRK file Do I = 1, 100 FromTo(1,I) = 0 FromTo(2,I) = 0 End Do Call StrCopy(Scratch,WildFName) Call BaseName(Scratch) Call GetFromTo(Scratch,FromTo) If (FromTo(1,1) .eq. 0) then ! if no ranges specified, use all FromTo(1,1) = Begin FromTo(2,1) = End End If ! ....... end of essential parameters ! ... now get non-essential parameters that are determined by the ! essential parameters ! ....... thresholds If (Protein) then Pair(1) = 1.5 ! threshold for identity Pair(2) = 1.0 ! ... for similarity Pair(3) = 0.5 ! ... for somewhat-similar Else Pair(1) = 1.0 Pair(2) = 1.0 Pair(3) = 1.0 End If Do I = 1,4 Answer = CLGetStrList('PAIr',Scratch,I) Wer = StrToReal(Scratch, A) If (Answer .and. Wer) Pair(I) = A End Do ! ....... do how many residues per line ! ........... first determine X & Y dimensions minus margin XDim = 800 - XMargin YDim = 600 - YMargin If (Orientation .eq. 'P') then XDim = 600 - XMargin YDim = 800 - YMargin End If ! ............... clear or set the counters for each sequence If (AskStart .and. Interact .and. & (Numbering.ne.'T') .and. & (Numbering.ne.'N')) then ! set for right side only Call WriteF('\n Please indicate starting numbers for:\n') Do I = 1, Number Call WriteF(' %s (* 1 *) ? ',Name(1,I)) Used(I) = GetIntNum('Starting number',-9999,99999,1) Used(I) = Used(I) - 1 End Do Else ! clear for everything else Do I = 1, Number Used(I) = 0 End Do End If ! special for consensus If (AskStart .and. Interact .and. (Numbering.ne.'N') .and. & Consensus) then If (Numbering.eq.'T') & Call WriteF('\n Please indicate starting number for:\n') Call WriteF(' Consensus (* 1 *) ? ') Used(Number+1) = GetIntNum('Starting number',-9999,99999,1) Used(Number+1) = Used(Number+1) - 1 Else Used(Number+1) = 0 End If ! ............... correct for right side numbering If ((Numbering.ne.'T') .and. (Numbering.ne.'N')) then I = End ! see how many characters involved Do J=1,6 ! ... yes, I know, crude way of doing If (I .lt. 1) K = J-1 ! this I = I / 10 End Do A = FontSize A = (A * Fudge) * K ! figure space taken up XDim = XDim - K End If ! ........... then see how much space the file names will take up, this ! is the fudge factor which is a percentage of the same ! number of residue characters; use the X margin. A = XDim - XMargin - (FontSize * MaxNameLen) * Fudge A = A / FontSize ! number of residues possible A = A - (A / BlockSize) * Spaces - 1.0 ! decrease for blocking size J = A / 5.0 ! round down to the nearest 5 J = J * 5 LineSize = CLRetInt( 'LINesize', 20, 150, J) ! ... generate consensus, needed even if user doesn't want it as we ! will use it to determine what box style is used. Start(Number+1) = Current - 1 Length(Number+1) = MaxLen Largest = 0.0 ! find largest entry in ! CmpTable Do L = 1, 26 Do K = L, 32 If (CmpTable(K,L) .gt. Largest) Largest = CmpTable(K,L) End Do End Do If (Largest .eq. 0) Largest = 0.01 ! just in case! Plurality = Plurality / Largest ! normalize Do J = 1, MaxLen ! one residue at a time Do K = 1, 32 Alpha(K) = 0.0 ! zero out count End Do Do I = 1, Number ! work with each seq. If (Weight(I) .ge. Threshold) then K = AlphaToNum(Residues(Start(I)+J)) ! get index If (Similarity) then ! ... if to consider similarity Do L = 1, 26 ! weighting Alpha(L) = Alpha(L) + CmpTable(L,K)*Weight(I) End Do Else Alpha(K) = Alpha(K) + Weight(I) ! ... normal weighting End If End If End Do Do K = 1, 26 Alpha(K) = Alpha(K) / Largest ! .. normalize End Do I = 32 Answer = .false. ! .. if more than one ! best match Do K = 1, 26 ! figure best match If (Alpha(K) .ge. Plurality) then If (Alpha(K) .eq. Alpha(I)) Answer = .true. If (Alpha(K) .gt. Alpha(I)) then Answer = .false. I = K End If End If End Do If ((Answer) .or. (I .ge. 32)) then ! add to consensus strand Residues(Current) = '-' Else Residues(Current) = NumToAlpha(I) End If Current = Current + 1 End Do ! ! ... that should be it for the setup part ! ! ... now write postscript header stuff into the output file Call InitPost(Out,WildFName,Title,Fat) ! internal routine ! ... now start on the actual residues ! ....... First, we need to define the page co-ordinates. From now on ! instead of working with postscript co-ordinates, we will work ! in co-ordinates of size 'fontsize' by 'fontsize' (e.g., for ! a fontsize of 12, the box will be 12 by 12 actual postscript ! units. ! ! We want a postscript unit margin on the left-X side and on ! the top-Y side; the previous XDim and YDim already incorporate ! the right- and bottom-side margins and if to do numbering on ! the right side. Let's figure the margin: A = FontSize I = (XMargin / A) + 0.95 ! to force rounding XBeginName = I I = (YMargin / A) + 0.95 YBegin = I ! The actual left margin for the sequence depends on the ! name lengths: A = MaxNameLen A = A * Fudge + 0.95 ! to force rounding I = A XBegin = XBeginName + I ! Get an X ending length (e.g., the right side) and a Y ending ! bottom (total page) length I = (LineSize / BlockSize) * Spaces XEnd = XBegin + LineSize + I - 1 If ((LineSize - I * BlockSize) .eq. 0) XEnd = XEnd - 1 YEnd = YDim / FontSize ! Because landscape and portrait count the Y direction in ! different methods, we need different starting points: YBase = 0 If (Orientation .eq. 'P') YBase = YEnd + 1 ! ... Now setup other stuff I = Str_Len(Title) ! Find where to center the header A = I A = A * Fudge J = A I = (XDim / FontSize) - XBeginName HeaderBegin = (I - J) / 2 + XBeginName Many = Number ! how many sequences there are, include If (Consensus) Many = Many + 1 ! consensus if needed Page = 0 YCur = YEnd + 3000 ! force a new page at the start Count = 9999 ! force a new line MaxCons = -99.9 ! clear consensus color marker ! ... Start processing Do J = 1, End ! go through each residue one at time If (Count .gt. LineSize) then ! new set of lines needed ! ...number just completed lines If ((Numbering.ne.'N').and.(Numbering.ne.'T')) then If (Count .lt. 9000) then ! ...... don't try 1st page Call RightNum(XCur,YCur,YBase, & Many,Used,Out,Number,Offset,Jump) End If End If YCur = YCur + Many + Blanklines ! ... update lines used, ! include blank lines K = Many + Blanklines ! ... see if new page needed If (Numbering.eq.'T') K = K + 1 If ((YCur + K) .gt. YEnd) then ! ... yes, new page needed If (Page.gt.0) then ! ...... end old page? Call FWriteF(out,'\nshowpage\n') End If Page = Page + 1 ! ...... start new page Call FWriteF(out,'%d %d scale\n',FontSize,FontSize) If (Orientation .eq. 'L') & Call FWriteF(out,'landscape\n') If (Density .eq. 'R') then Call FWriteF(out,'rough\n') Else Call FWriteF(out,'fine\n') End If Call FWriteF(out,'0 setgray\n') Call FWriteF(out,'\n%%%%Page: %d %d\n',Page,Page+1) If (Header) then ! ...... do header? Call FWriteF(out,'%d %d moveto\n', & HeaderBegin,YBase-YBegin-1) Call FWriteF(out,'(%s) show\n',Title) YCur = YBegin + Blanklines + 1 Else YCur = YBegin End If ! ...... end of header End If ! ... end of page startup Call FWriteF(out,'0 setgray\n') ! ... make sure text shows If (Numbering.eq.'T') then ! ... do top numbering YCur = YCur + 1 ! ....... left side B = YBase - YCur + 0.2 A = XBegin + 0.2 Call FWriteF(out,'%6.1f %6.1f moveto\n',A,B) K = Used(Number+1)+1 Call FWriteF(out,'(%d) show\n',K) ! ....... right side M = LineSize ! find # of letters If (J+Linesize .gt. End) M = End - J + 1 ! get position A = XBegin + 0.2 - 1.0 + M + Spaces*((M-1)/BlockSize) ! get what to print K = Used(Number+1)+LineSize If (J+Linesize .gt. End) K = Used(Number+1)+End-J+1 M = K AA = XBegin Do L=1,8 ! adjust depending If (M/10 .gt. 0) then ! on what needs to A = A - Fudge ! be printed AA = AA + Fudge M = M / 10 End If End Do AA = AA + Fudge ! to make sure there ! is room to print If (A .ge. AA) then ! do print Call FWriteF(out,'%6.1f %6.1f moveto\n',A,B) Call FWriteF(out,'(%d) show\n',K) End If End If ! end of top numbering Do I = 1, Many ! ... write names A = YBase-YCur-I If ((I .ne. Number+1) .or. .not.Offset) & A = A + 0.2 Call FWriteF(out,'%d %6.1f moveto\n(%s) show\n', & XBeginName,A,Name(1,I)) End Do XCur = XBegin ! ... set starting point Count = 1 End If ! end of needing new line Used(Number+1) = Used(Number+1) + 1 ! increment actual residue count Do I = 1, Number K = AlphaToNum(Residues(Start(I)+J)) If (K .le. 26) Used(I) = Used(I) + 1 End Do If (J .lt. Begin) Goto 300 ! jump rest if not applicable ! figure out level of match ! to the consensus, assign ! value levels K = AlphaToNum(Residues(Start(Number+1)+J)) If (K .eq. 32) then Value(K) = 4 Else Value(K) = 1 End If Do I = 1, Number + 1 If (I .ne. Number+1) then ! ... don't do consensus Value(I) = 4 ! ... no match assumed L = AlphaToNum(Residues(Start(I)+J)) A = CmpTable(L,K) Do L=3,1,-1 If (A .ge. Pair(L)) Value(I) = L End Do If (A .ge. MaxCons) MaxCons = A Else ! ... special for consensus Value(I) = 4 Do L = 3,1,-1 If (MaxCons .ge. Pair(L)) Value(I) = L End Do End If End Do If (Identity) then ! see if to only match if ! everything matches Answer = .true. Do I = 2, Number If (Value(I) .ne. Value(I-1)) Answer = .false. End Do If (.not.Answer) then ! ... not everything the same Do I = 1, Many Value(I) = 4 End Do End If End If ! Only do plotting if within ! FromTo boundries Answer = .false. Do M = 1, 100 If ((J.ge.FromTo(1,M)).and.(J.le.FromTo(2,M))) then Answer = .true. Goto 260 End If End Do 260 Continue If (.not.Answer) then Do I=1,Many Value(I) = 4 End Do End If ! see if to change case If (Case.and.(.not.Answer)) then Do I=1,Many If (Value(I) .ne. 1) then Residues(Start(I)+J) = & ChToLower(Residues(Start(I)+J)) Else Residues(Start(I)+J) = & ChToUpper(Residues(Start(I)+J)) End IF End Do End If Do I = 1, Many ! do actual plotting K = ColorIndex(Value(I)) ! ... see what color to use A = YBase-YCur-I ! ... where to plot If ((I .eq. Number+1) .and. Offset) & A = A - 0.2 ! ... offset consensus a bit Call FWriteF(out,'(%c) %d %6.1f %s\n', & Residues(Start(I)+J),XCur,A,ColorNames(1,K)) End Do Count = Count + 1 ! go to next column MaxCons = -99.9 XCur = XCur + 1 I = Count / BlockSize ! ... check for blank column(s) If (Count .eq. 1) I = 9 ! ... ignore 1st blank If ((Count - (I * BlockSize)) .eq. 1) then XCur = XCur + Spaces Jump = .true. Else Jump = .false. End If 300 Continue End Do ! end of going through all the residues ! finish up If ((Numbering.ne.'N').and.(Numbering.ne.'T')) & Call RightNum(XCur+1-Spaces,YCur,YBase,Many,Used,Out, & Number,Offset,.true.) Call FWriteF(out,'\nshowpage\n') Call FWriteF(out,'\n%%%%Pages: %d\n',Page) ! ... whew, all done, do accounting and exit Call Account('PrettyBox') Call GCGExit() End ! of PrettyBox main block Subroutine RightNum(X,Y,B,Many,Used,Out,Num,Off,Jump) ! to do numbering at right side Implicit None Integer X,Y,B,Many,Used(*),Out,Num,I Logical Off, Jump Real A Call FWriteF(Out,'0 setgray\n') If (.not.Jump) X = X+1 Do I=1,Many A = B-Y-I If ((I .ne. Num+1) .or. .not.Off) A = A + 0.2 Call FWriteF(Out,'%d %6.1f moveto\n(%d) show\n', & X,A,Used(I)) End Do Return End ! of RightNum Subroutine InitPost(Out,FName,Title,Fat) ! write initial code to output file Implicit None Integer Out Character FName(*), Title(*) Integer I,UserName,TimeConCat Character Scratch(100) Logical Fat ! this subroutine is just a bunch of FWriteF statements with ! a couple of calls to figure who the user is and the date Call FWriteF(Out,'%!PS-Adobe-1.0\n') I = UserName(Scratch) Call FWriteF(Out,'%%%%Creator: %s\n',Scratch) Call StrCopy(Scratch,' ') I = TimeConcat(Scratch) Call FWriteF(Out,'%%%%CreationDate:%s\n',Scratch) Call SWriteF(Title,'PRETTYBOX of: %s %s',FName,Scratch) Call FWriteF(Out,'%%%%Title: %s\n',Title) Call FWriteF(Out,'%%%%Pages: (atend)\n') If (Fat) then Call FWriteF(Out,'%%%%DocumentFonts: Courier-Bold\n') Else Call FWriteF(Out,'%%%%DocumentFonts: Courier\n') End If Call FWriteF(Out,'%%%%EndComments\n') Call FWriteF(Out,' \n') Call FWriteF(Out,'%%Note: This is postscript output and'// & ' must be printed/displayed on \n') Call FWriteF(Out,'%% a postscript-compatible device \n') Call FWriteF(Out,' \n') Call FWriteF(Out,' \n') Call FWriteF(Out,'%%... get the font \n') Call FWriteF(Out,' \n') If (Fat) then Call FWriteF(Out,'/Courier-Bold findfont setfont \n') Else Call FWriteF(Out,'/Courier findfont setfont \n') End If Call FWriteF(Out,' \n') Call FWriteF(Out,'%%... set lines per inch \n') Call FWriteF(Out,'/fine {90 120 {180 mul cos exch 180 mul'// & ' cos add 2 div} setscreen} def \n') Call FWriteF(Out,'/rough {60 75 {180 mul cos exch 180 mul'// & ' cos add 2 div} setscreen} def \n') Call FWriteF(Out,' \n') Call FWriteF(Out,'%%... to draw & fill in a box \n') Call FWriteF(Out,'/box { \n') Call FWriteF(Out,' 0 1 rlineto \n') Call FWriteF(Out,' 1 0 rlineto \n') Call FWriteF(Out,' 0 -1 rlineto \n') Call FWriteF(Out,' fill \n') Call FWriteF(Out,' } def \n') Call FWriteF(Out,' \n') Call FWriteF(Out,'%%... to draw a box and a letter '// & 'together, to use: \n') Call FWriteF(Out,'%% (letter) x y '// & 'routine_name \n') Call FWriteF(Out,' \n') Call FWriteF(Out,'/dowhite { %%do boxes '// & 'with white letters \n') Call FWriteF(Out,' newpath \n') Call FWriteF(Out,' setgray \n') Call FWriteF(Out,' 2 copy \n') Call FWriteF(Out,' moveto \n') Call FWriteF(Out,' box \n') Call FWriteF(Out,' moveto \n') Call FWriteF(Out,' 1 setgray \n') Call FWriteF(Out,' .22 .2 rmoveto \n') Call FWriteF(Out,' show \n') Call FWriteF(Out,' } def \n') Call FWriteF(Out,' \n') Call FWriteF(Out,'/doblack { %%do boxes with'// & ' black letters \n') Call FWriteF(Out,' newpath \n') Call FWriteF(Out,' setgray \n') Call FWriteF(Out,' 2 copy \n') Call FWriteF(Out,' moveto \n') Call FWriteF(Out,' box \n') Call FWriteF(Out,' moveto \n') Call FWriteF(Out,' 0 setgray \n') Call FWriteF(Out,' .22 .2 rmoveto \n') Call FWriteF(Out,' show \n') Call FWriteF(Out,' } def \n') Call FWriteF(Out,' \n') Call FWriteF(Out,'/black { %%black box, '// & ' white letter \n') Call FWriteF(Out,' 0 dowhite \n') Call FWriteF(Out,' } def \n') Call FWriteF(Out,' \n') Call FWriteF(Out,'/white { %%white box, '// & ' black letter \n') Call FWriteF(Out,' 1 doblack \n') Call FWriteF(Out,' } def \n') Call FWriteF(Out,' \n') Call FWriteF(Out,'/dark { %%dark'// & ' grey box, white letter \n') Call FWriteF(Out,' 0.5 dowhite \n') Call FWriteF(Out,' } def \n') Call FWriteF(Out,' \n') Call FWriteF(Out,'/light { %%light grey '// & 'box, black letter \n') Call FWriteF(Out,' 0.8 doblack \n') Call FWriteF(Out,' } def \n') Call FWriteF(Out,' \n') Call FWriteF(Out,'/pale { %%very '// & ' pale grey box, black letter \n') Call FWriteF(Out,' 0.95 doblack \n') Call FWriteF(Out,' } def \n') Call FWriteF(Out,' \n') Call FWriteF(Out,'/landscape { %%landscape '// & ' printing; note, no portrait defined \n') Call FWriteF(Out,' 90 rotate \n') Call FWriteF(Out,' } def \n') Call FWriteF(Out,' \n') Call FWriteF(Out,'%%EndProlog \n') Call FWriteF(Out,' \n') Return End ! of InitPost