!*** PRETTYPLOT ************************************************************* !* !* This program reads a number of sequences and writes them out in !* graphic text format with boxes around conserved regions. !* !* Based on Pretty program in GCG !* Copyright 1983 Paul Haeberli and John Devereux !* Revised October 1985 for version 4.0 by John Devereux !* converted to graphics by Peter Rice (EMBL) November 1989 !* Color output added by Jaakko Hattula (EMBL) July 1993 !* Code cleaned up by Peter Rice (Sanger Centre) November 1994 !* !****************************************************************************** Program PrettyPlot Implicit None Include 'EGenInclude:PrettyPlot.Inc' Record /Sequence/SQ Character OutFName(256) Integer InFile, OutFile Integer Pos, Length Integer Stream/1/ Logical CaseDone /.false./ Logical Text, Plot Logical PlotCase, PlotDifferences Logical Differences, Case Logical Rev Integer Cmp(32,32) Character CmpFName(256) Integer CmpFile Real TotWeight Logical EGetDataFile, EInteract Real EMeanReal, ESumReal Real GetRealNum, CLRetReal Integer GetString, Str_Len Logical NextFile, ReOpenF, SQRead, CLRetBool Logical CLGetWildFName, CLGetNewFName Logical CLGetReal, CLGetStr Real SetWeights Logical IsProtein Call EInit ('prettyplot') CSeq = MAXMSFSEQS Identity = CLGetStr ('IDEntity', IdentSym) CharIdent = Str_Len(IdentSym).eq.0 Call ECLGetBool ('CONsensus', .false., Consensus) Call ECLGetBool ('CASe', .false., Case) Call ECLGetBool ('DIFferences', .false., Differences) Call ECLGetBool ('TEXT', .false., Text) ! /TEXT turns output file on Call ECLGetBool ('PLOT', .true., Plot) ! /NOPLOT turns plotting off Call ECLGetReal ('THReshold', -100.0, 100.0, 1.0, Threshold) !* is this really Ugly or is it really Pretty (it's sometimes hard to tell) !* if it is ugly, just rewrite the input file (from Pretty) as single files !* and stop the program If ( CLRetBool('UGLy') ) Then Call Ugly () Call Account () Call EStop () End If Call EGetWildFSeq (WildFName) Call EMSFLoad (MSQ, Seq, MAXSTRLEN, SQ, WildFName) Call EMSFGetRange (Begin, End, Rev) Weight = EMeanReal (MSQ.Weight, MSQ.NSeqs, 1.0) TotWeight = ESumReal (MSQ.Weight, MSQ.NSeqs) MinCon = Min(TotWeight, (TotWeight+Weight)/2.) CSeq = MSQ.NSeqs + 1 !* Get range, and output file If ( MSQ.NSeqs .le. 0 ) Then Call WriteF('\n\n *** No files in "%s"! ***\n\b', WildFName) Call EStopBad() End If If ( EInteract() ) Call WriteF('\n') Call ECLGetReal ('PLUrality', -100.0, TotWeight, MinCon, MinCon) If ( Text) Then Call ESetFName (OutFName, WildFName, '.pretty') Call EGetOutFText (OutFile, OutFName) Call FWriteF(OutFile, 'PRETTYPLOT of: %s %t ..\n', & WildFName) End If !* pick up the symbol comparison table If ( IsProtein(Seq) ) then Call ECLGetStr ('VOTes', 'prettypep.cmp', CmpFName) Else Call ECLGetStr ('VOTes', 'prettydna.cmp', CmpFName) End If If ( EGetDataFile(CmpFile, CmpFName) ) then If ( EInteract() ) Call WriteF('\n ***'// & ' I used your table "%s" for consensus comparison ***\n\b', & CmpFName) End If Call ReadCmpTab (CmpFile, Cmp) Call ECmpMatch (Cmp, AveMatch, AveMisMatch) !* change the sequences for case or differences and add the consensus If ( Consensus .or. Case .or. Differences ) then CaseDone = (Case .or. Differences) Call VoteConsensus(Case, Differences, Cmp) If ( Text ) Then If ( ( Consensus .and. .not.Identity) .or. Case .or. & Differences ) Call FWriteF(OutFile, & 'Plurality: %.2f '// & 'Threshold: %.2f AveWeight %.2f '// & 'AveMatch %.2f AvMisMatch %.2f\n\n', & MinCon, Threshold, Weight, & AveMatch, AveMisMatch) End If End If !* Write the sequences into the output file If ( Text ) Then Call PrettyOut(OutFile) Call CloseF (OutFile) End If !* Now for the plotting extensions If ( Plot ) Then !* Set the case (even if not asked for) - only upper case will be boxed If ( .not. CaseDone ) Then PlotCase = .true. PlotDifferences = .false. Call VoteConsensus (PlotCase, PlotDifferences, Cmp) End If !* and plot the results Call PrettyPlotIt (Cmp) End If If ( EInteract() ) Call WriteF('\n') Call Account () Call EStop () End ! of PrettyPlot main block !*** PrettyOut ************************************************************** !* !* This writes the strings out in a text format. !* 1 50 !* hybrid.seq TGTGATATGT AGAAGGAGGA GCCTGGTGAT GGTGTTCCGA GTAGAGAGGC !* alanalu.gap TGTGATATGG AGGAGAATGA GCATAGTTTT TGTATGC... .......... !* alpha1alu.gap .......... .......... .......... .......... .......... !* alugamma.gap .......... .......GGA TCCTAGATAT TCCTTAGTCT GAGGAGGAGC !* alugamma2.gap .......... .......... .......... .......... .......... !* !****************************************************************************** Subroutine PrettyOut( OutFile ) Implicit None Include 'EGenInclude:PrettyPlot.Inc' Integer OutFile Integer Start, Finish, Margin, LineSize, BlockSize Integer i Character Format1(256), Format2(256), OutLine(256) Integer CLRetInt, Spaces, LineLen Logical FirstCall /.true./ If ( FirstCall ) then Call ECLGetInt('LINESize', 1, 250, 50, LineSize) Call ECLGetInt('DENSity', 1, 250, LineSize, LineSize) Call ECLGetInt('BLOcksize', 1, LineSize, 10, BlockSize) Margin = MSQ.MaxName + 2 If (Consensus) Margin = Max (Margin, 10) Call SWriteF(Format2, '%%%ds ', Margin-2) FirstCall = .false. End If Start = Begin Do While (Start .le. End) Finish = Min(End, Start+LineSize-1) LineLen = Finish - Start + 1 Spaces = (LineLen-1)/BlockSize Call FWriteF (OutFile, '\n') If ( LineLen.ge.10 ) then Call SWriteF(Format1, '%%%dp%%-5d%%%dp%%5d\n', & Margin, Margin+LineLen+Spaces-5) Call FWriteF(OutFile, Format1, Start, Finish) Else Call SWriteF(Format1, '%%%dp%%-5d\n', & Margin ) Call FWriteF(OutFile, Format1, Start) End If Do i = 1, MSQ.NSeqs Call SWriteF(OutLine, Format2, MSQ.Name(1,i)) Call WriteSeqLine(OutFile, Seq(MSQ.Start(i)), & MSQ.Len(i), Start, Finish, Margin, BlockSize, & OutLine) End Do If (Consensus) Then Call SWriteF(OutLine, Format2, MSQ.Name(1,CSeq)) Call WriteSeqLine(OutFile, Seq(MSQ.Start(CSeq)), & MSQ.Len(CSeq), Start, Finish, Margin, BlockSize, & OutLine) End If Call FWriteF(OutFile, '\n') Start = Start + LineSize End Do Return End ! of PrettyOut !*** WriteSeqLine *********************************************************** !* !* !* Like this: !* !* hybrid.seq TGTGATATGT AGAAGGAGGA GCCTGGTGAT GGTGTTCCGA GTAGAGAGGC !* !* !****************************************************************************** Subroutine WriteSeqLine( OutFile, Seq, & Length, Start, Finish, Margin, BlockSize, OutLine) Implicit None Integer OutFile, Length Character Seq(*) Integer Start, Finish, Margin, BlockSize Character OutLine(*) Integer Pos, Spaces, Nout, i, j !* Write them all out to the file in a nice format If ( Finish.lt.Start ) Return Nout = Finish-Start+1 Spaces = 0 j = Margin Pos = Start Do I = 1, Nout j = j + 1 If ( Pos.le.Length .or. Seq(Pos).eq.' ' ) Then OutLine(j) = Seq(Pos) Else OutLine(j) = '.' End If Pos = Pos + 1 If ( Mod(I,BlockSize).eq.0 ) Then Spaces = Spaces + 1 j = j + 1 OutLine(j) = ' ' End If End Do j = j + 1 OutLine(j) = Char(0) Call WriteString(OutFile, OutLine) Return End ! of WriteSeqLine !*** Ugly ******************************************************************* !* !* rewrites the files from an edited pretty file into individual sequence !* files in GCG format !* !****************************************************************************** Subroutine Ugly () Implicit None Include 'EGenInclude:PrettyPlot.Inc' Record /Sequence/ SQ Character FNames(256,MAXMSFSEQS), ThisFName(256), ThisName(256) Character PretFName(256), Out2FName(256), OneLine(256) Character UWSymbols(0:255) Integer InFile, OutFile, Out2File Integer GetString, ReadString, StrToken Integer Length, i, Pos Logical CLGetOldFName, CLGetNewFName Logical ReOpenF, CIStrMatch Integer SeqLen, StrFilter !* get the legal symbol set Call SymbolSet(UWSymbols) UWSymbols(IChar('-')) = 'X' ! consensus seq can't tell !* the pretty input file Call EGetInFText (InFile, PretFName) !* and find the sequence names in that file Call FindNames (InFile, FNames) !* now open and document the ugly "file of file names" output file Call ESetFName (Out2FName, PretFName, '.fil') Call EGetOutFText (Out2File, Out2FName) Call FWriteF(Out2File, ' UGLY file of file names of:'// & ' %s %t ..\n\n', PretFName) i = 1 Do While ( FNames(1,i).ne.Char(0) ) Call ESetFName (ThisFName, FNames(1,i), ',ugly') If ( ReOpenF(OutFile, ThisFName, 'w') ) Then Call RewindF (InFile) Call SkipDown (InFile, '..', OneLine) SQ.Seq(1) = Char(0) Do While ( ReadString(InFile, OneLine, Length).ge.0 ) Pos = 1 If ( StrToken(ThisName, OneLine, Pos).ne.0 ) Then If ( CIStrMatch(ThisName, FNames(1,i)) ) Then Call StrConCat(SQ.Seq, OneLine(Pos)) End if End If End Do SeqLen = StrFilter(SQ.Seq, UWSymbols) Call WriteF('\n %20s len: %d', ThisFName, SeqLen) Call SQWrite(OutFile, SQ.Seq, ThisFName) Call FWriteF(Out2File, '%-20s 1.00\n', ThisFName) Else Call WriteF ('\n\n\b *** unable to open "%s"\n', ThisFName) End If i = i + 1 End Do End ! of Ugly !*** FindNames ************************************************************** !* !* finds out what names are in the PRETTY file and writes them into !* the Names buffer. !* !****************************************************************************** Integer Function FindNames (File, Names) Implicit None Character Names(256,*) Integer File Logical LTemp Integer i, Pos, Length, IntVal Character ThisName(256), OneLine(256) Integer FieldCount, StrToken, ReadString Logical CIStrMatch, StrToInt, SkipDown FindNames = 0 Call RewindF (File) If ( .not.SkipDown(File, '..', OneLine) ) then Call WriteF('\n\n\b *** ERROR in FINDNAMES, '// & ' No line with ".." separates text from data! ***\n') Call EStopBad () End If i = 1 Do While ( ReadString(File, OneLine, Length).ge.0 ) Pos = 1 LTemp = FieldCount(OneLine).ge.2 If ( LTemp .and. & StrToken(ThisName, OneLine, Pos).gt.0 ) then If ( .not.StrToInt(ThisName, IntVal) ) then If ( .not.CIStrMatch(ThisName, Names(1,1)) ) then Call StrCopy(Names(1,i), ThisName) i = i + 1 Else Names(1,i) = Char(0) FindNames = i - 1 Return End If End If End If End Do Return End ! of FindNames !*** VoteConsensus ********************************************************** !* !* adds a row to Seq with the consensus for the column. !* !****************************************************************************** Subroutine VoteConsensus(Case, Differences, Cmp) Implicit None Include 'EGenInclude:PrettyPlot.Inc' Logical Case, Differences Character ColString(MAXMSFSEQS+1) Integer i, j Integer Cmp(32,32) Character ConsChar Character Votes Integer AlphaToNum !* add "Consensus" to the MSQ.Names Call StrCopy(MSQ.Name(1,CSeq), 'Consensus') !* create a string with the symbols from each column of Seq !* and put the consensus in into new bottom row. MSQ.Start(CSeq) = MSQ.Start(MSQ.NSeqs) & + MSQ.Len(MSQ.NSeqs) + 1 MSQ.Len(CSeq) = MSQ.MaxLen Do i = 0, MSQ.MaxLen-1 Do j = 1, MSQ.NSeqs If ( i.lt.MSQ.Len(j) .and. & AlphaToNum(Seq(MSQ.Start(j)+i)).lt.32 ) Then ColString(j) = Seq(MSQ.Start(j)+i) Else ColString(j) = '.' End If End Do ColString(MSQ.NSeqs+1) = Char(0) ConsChar = Votes (ColString, Cmp, Case, Differences) Do j = 1, MSQ.NSeqs If ( i.lt.MSQ.Len(j) ) Then Seq(MSQ.Start(j)+i) = ColString(j) End If End Do Seq(MSQ.Start(CSeq)+i) = ConsChar End Do Seq(MSQ.Start(CSeq)+MSQ.MaxLen) = Char(0) Return End ! of AddConsensus !*** Votes ***************************************************************** !* !* returns the number of residues in ColString that can agree with the !* best coalition. !* !****************************************************************************** Character Function Votes ( ColString, Cmp, Case, Differences) Implicit None Include 'EGenInclude:PrettyPlot.Inc' Character ColString(*) Integer Cmp(32, *) Logical Case, Differences Character NumStr(MAXMSFSEQS+1), UpStr(MAXMSFSEQS+1) Character DiffStr(64), CountChars(2), MatchStr(MAXMSFSEQS+1) Character ChToUpper, ChToLower, MatchChar Integer Depth, StrCopy, Pos, Matches Integer i, j, k Real Members, MaxMembers Integer IThreshold Logical Collision, CCollision, MatchVector(MAXMSFSEQS+1) Logical CheckCollision, Known Logical FirstCall /.true./ Integer StrCount, IntCmpVal !* initialize If (FirstCall) Then Call ECLGetStr('DIFferences', ' ', DiffStr) Call ECLGetBool('COLlisions', .true., CheckCollision) IThreshold = IntCmpVal (Threshold) FirstCall = .false. End If Depth = StrCopy(NumStr, ColString) Call SeqToNum(NumStr) Depth = StrCopy(UpStr, ColString) Call StrToUpper(UpStr) !* see if there is any coalition larger than MinCon(sensus) MaxMembers = 0.0 Collision = .false. Pos = 1 Matches = 0 MatchStr(1) = Char(0) Do i = 1, Depth Members = 0.0 Do j = 1, Depth If ( Cmp(IChar(NumStr(i)),IChar(NumStr(j))) .ge. IThreshold ) & Members = Members + MSQ.Weight(j) End Do !* members is consensus score for ColString(i) against all residues If (CheckCollision) Then If ( Members .gt. MaxMembers ) Then ! New single high scorer Collision = .false. MaxMembers = Members Matches = 1 MatchStr(1) = NumStr(i) MatchStr(2) = Char(0) Pos = i Else If ( Members .eq. MaxMembers) Then ! maybe current consensus If (Members .gt. 0.0) Then If (Cmp(IChar(NumStr(i)),IChar(MatchStr(1))) & .lt. IThreshold ) Collision = .true. End If End If Else ! take anything over plurality (MinCon) If ( Members .ge. MinCon) Then If ( Members .gt. MaxMembers ) Then MaxMembers = Members Matches = Matches + 1 MatchStr(Matches) = NumStr(i) MatchStr(Matches+1) = Char(0) Else Known = .false. Do k = 1, Matches If (Cmp(IChar(NumStr(i)),IChar(MatchStr(k))) & .ge. IThreshold ) Known = .true. End Do If (.not. Known) Then ! a new possible consensus character Matches = Matches + 1 MatchStr(Matches) = NumStr(i) MatchStr(Matches+1) = Char(0) End If End If End If End If End Do Collision = Collision .or. (MaxMembers .lt. MinCon) !* now set the case of the members of each coalition Do i = 1, Depth Known = .false. If ( .not. Collision) Then Do k = 1,Matches If (Cmp(IChar(MatchStr(k)),IChar(NumStr(i))) & .ge. IThreshold ) Known = .true. End Do End If If (Known) Then If ( Case ) Then ColString(i) = ChToUpper(ColString(i)) Else If ( Differences ) Then ColString(i) = DiffStr(1) End If MatchVector(i) = .true. Else If ( Case .or. Differences ) & ColString(i) = ChToLower(ColString(i)) MatchVector(i) = .false. End If End Do !* now decide which symbol to put into the consensus position MaxMembers = 0.0 CCollision = .false. MatchChar = '~' Pos = 1 Do i = 1, Depth If ( MatchVector(i) ) Then Members = 0.0 Do j = 1, Depth If ( MatchVector(j) .and. UpStr(i).eq.UpStr(j) ) & Members = Members + MSQ.Weight(j) End Do If ( Members .gt. MaxMembers ) Then MaxMembers = Members MatchChar = UpStr(i) Pos = i CCollision = .false. Else If ( Members .eq. MaxMembers .and. & UpStr(i) .ne. MatchChar ) Then CCollision = CheckCollision End If End If End Do If ( Identity ) then CountChars(1) = UpStr(1) CountChars(2) = Char(0) If ( StrCount(UpStr, CountChars, Depth).eq.Depth ) then If ( CharIdent ) then Votes = UpStr(1) Else Votes = IdentSym(1) End If Else Votes = '-' End If Else If ( Collision .or. CCollision ) Then Votes = '-' Else Votes = UpStr(Pos) End If ColString(Depth+1) = Char(0) Return End ! of Votes !*** PrettyPlotIt ************************************************************ !* !* Produce the boxed graph from the sequence output of SetCase !* Any residue in upper case is boxed. !* All residues are printed in upper case !* Gaps are printed as dashes (-) for clarity !* !****************************************************************************** Subroutine PrettyPlotIt (Cmp) Implicit None Include 'EGenInclude:PrettyPlot.Inc' Real Left/15./, Right/140./ Real Top/85./, Bottom/15./ Real ColInc /2./ Real RowInc /2./ Integer Cmp (32,32) Integer LineSize Character ChToUpper Integer i,j,k Integer Pos, Line, Last Real x, y, xt, yt Logical ChIsUpper Integer TruePos(MAXMSFSEQS) Logical Number /.true./ Logical Name /.true./ Logical Title /.true./ Logical NumberTop Logical UseStar Character StarChar(20 001) Integer StarPos Integer StarFile Integer TopSeq, StarSeq Character StarName(256), TopName(256) Character StarFName(256), StarLine(512) Integer StarLen Real MaxLen Real YPos Real Numyt, Staryt Real Topy, Topyt Real Namext, Numxt Real CHeight, NameHeight Integer Page Real Aspect /0.6/ Logical FirstCall /.true./ Logical Colors /.false./ Logical NoBox /.false./ Integer MaxNameSize Logical IsNull Character Residue Logical CaseDiff Logical ECLGetStr Logical CIStrMatch, OpenF, StrToInt Logical CLGetStr, CLRetBool, ChIsAlpha Integer ReadString Real WTextLen If (FirstCall) Then Consensus = .false. Call ECLGetBool ('CONsensus', .false., Consensus) Call ECLGetBool ('STAR', .false., UseStar) Call ECLGetBool ('TOPNUMber', .false., NumberTop) Call ECLGetInt ('LINESize', 1, 250, 50, LineSize) Call ECLGetInt ('DENSity', 1, 250, LineSize, LineSize) Call ECLGetBool('NUMber', .true., Number) Call ECLGetBool('NAME', .true., Name) Call ECLGetBool ('CCOLors', .false., CColors) CColors = CColors .or. CLRetBool ('CCOLours') .or. 1 CLRetBool('CIDentity') .or. 1 CLRetBool('CSImilarity') .or. 1 CLRetBool('COThers') Call ECLGetStr('CIDentity', 'RED', CIdentity) Call ECLGetStr('CSImilarity', 'GREEN', CSImilarity) Call ECLGetStr('COThers', 'BLACK', COthers) YPos = Float(MSQ.NSeqs+2) If (Consensus) YPos = YPos + 2. If (NumberTop) YPos = YPos + 2. If (UseStar .and. .not.NumberTop) YPos = YPos + 1. ColInc = (Right - Left) / Float(LineSize+1) RowInc = (Top - Bottom) / YPos ColInc = Min (ColInc, RowInc) RowInc = ColInc CHeight = Min (1.5, 0.6*ColInc) Top = 97. - 4.*CHeight - 2.*RowInc If (NumberTop) Top = Top - 2.*RowInc If (UseStar .and. .not.NumberTop) Top = Top - RowInc j = 1 Do While (j .lt. Begin) Do k = 1, MSQ.NSeqs If (ChIsAlpha(Residue(k,j))) TruePos(k) = TruePos(k) + 1 End Do j = j + 1 End Do TruePos (CSeq) = Begin-1 MaxLen = Aspect*CHeight*Float(MSQ.MaxName + 2) If (Consensus) Then MaxLen = Max (MaxLen, Aspect*CHeight*12.) End If NameHeight = Min (CHeight, CHeight*(Left-ColInc)/MaxLen) If (NumberTop) Then If (CLGetStr('TOPNUMber', TopName)) Then If (IsNull(TopName)) Then TopSeq = CSeq Else TopSeq = 0 Do i = 1, MSQ.NSeqs If (CIStrMatch(TopName, MSQ.Name(1,i))) TopSeq = i End Do If (CIStrMatch(TopName, MSQ.Name(1,CSeq))) TopSeq = CSeq End If If (TopSeq .eq. 0) Then Call WriteF ('Error, sequence "%s" not found in %s, '// & 'consensus used instead\n', & TopName, WildFName) TopSeq = CSeq End If Else TopSeq = CSeq End if End if If (UseStar) then If (CLGetStr ('STARSEQ', StarName) ) Then If (IsNull(StarName)) Then StarSeq = CSeq Else StarSeq = 0 Do i = 1, MSQ.NSeqs If (CIStrMatch(StarName, MSQ.Name(1,i))) StarSeq = i End Do If (CIStrMatch(StarName, MSQ.Name(1,CSeq))) StarSeq = CSeq End If If (StarSeq .eq. 0) Then Call WriteF ('Error, sequence "%s" not found in %s, '// & 'consensus used instead\n', & StarName, WildFName) StarSeq = CSeq End If Else StarSeq = CSeq End if Call ESetFName (StarFName, WildFName, '.star') Call CLGetOldFName('STAR', 1000, StarFName) If (OpenF (StarFile, StarFName, 'r')) Then Call SkipText (StarFile, '..') Do While (ReadString(StarFile, StarLine, StarLen) .ge. 0) If (StarLen .gt. 0) Then If (StrToInt (StarLine, StarPos) ) Then If ((StarPos .ge. 1) .and. & (StarPos .le. 20 000)) Then StarChar(StarPos) = '*' Else Call WriteF ( & 'Error in %.2n, invalid position %d\n', & StarFile, StarPos) End If End If End If End Do Call CloseF (StarFile) Else Call WriteF ('Error, star file %s not found\n', & StarFName) UseStar = .false. End If End If !* Choose use colors or not Call ECLGetBool ('DOCOLours', .false., Colors) Call ECLGetBool ('DOCOLors', Colors, Colors) C Mathog, 14-JUN-1995 Call ECLGetBool ('NOBOX', NoBox,NoBox) Call EWPlotBegin(WildFName, MSQ.Check, Begin, End) FirstCall = .false. End If !* here we go !* i = sets the block of lines !* j = sets the position with a line (horizontal position) !* k = sets the sequence number (vertical position) Line = 0 Pos = Begin - 1 y = -1. Page = 0 Do i = Begin, End, LineSize Call WTextOrg (5) If (y .lt. RowInc*YPos) Then ! new page yt = Top + RowInc/2. y = Top If (Line .ne. 0) Call EWPlotExit () Call EWPlotInit (Begin, End) Line = 0 End If If (NumberTop) Then Numyt = yt yt = yt - RowInc y = y - RowInc End If If (UseStar) Then C Mathog 14-JUN-1995 Staryt = yt - RowInc C Staryt = yt yt = yt - RowInc y = y - RowInc Else If (NumberTop) Then yt = yt - RowInc y = y - RowInc End If Topyt = yt Topy = y x = Left xt = x + 0.5*ColInc Namext = xt Numxt = Namext + Float(LineSize + 1)*ColInc j = 0 Last = Min (End, Pos+LineSize) Do While (Pos .lt. Last) j = j + 1 Pos = Pos + 1 yt = Topyt y = Topy xt = xt + ColInc x = x + ColInc TruePos(CSeq) = Pos !* the aligned sequences Call WTextOrg (5) C Mathog, 14-JUN-1995, fix problem with first character in alignment C comes out the size of the Title(???) Call WCHeight(CHeight) C Do k = 1, MSQ.NSeqs yt = yt - RowInc y = y - RowInc If (ChIsAlpha(Residue(k,Pos))) & TruePos(k) = TruePos(k) + 1 If (MSQ.Len(k) .ge. Pos) Then Call WMoveTo(xt, yt) If (ChIsAlpha(Residue(k,Pos))) Then If (CColors) Call CColor(k, pos, Cmp) If (Colors) Call Color(Residue(k,pos)) Call WPlotF('%c\c', ChToUpper(Residue(k,Pos))) Call WNewColor(1) Else Call WPlotF('-\c') End If End If !* Vertical lines !* Conserved residues at start of line If (j .eq. 1) Then If (Name) Then Call WTextOrg (8) Call WCHeight(NameHeight) Call WMoveTo (Namext, yt) Call WPlotF('%s\c',MSQ.Name(1,k)) Call WCHeight(CHeight) Call WTextOrg (5) End If If (.not. NoBox .and. ChIsUpper(Residue(k,Pos))) Then Call WMoveTo (x, y) Call WRelDraw (0., RowInc) End If Else !* Conserved residue after non-conserved If (.not. NoBox .and. CaseDiff(Residue(k,Pos), & Residue(k,Pos-1))) Then Call WMoveTo(x, y) Call WRelDraw (0., RowInc) End If End If !* Conserved residue at end-of-line or end-of-sequence If ((j .eq. LineSize) .or. (Pos .eq. End) .or. & (Pos .eq. MSQ.Len(k))) Then If (Number) Then Call WTextOrg (2) Call WMoveTo (Numxt, yt) Call WPlotF('%5d\c',TruePos(k)) Call WTextOrg (5) End If If (.not. NoBox .and. ChIsUpper(Residue(k,Pos))) Then Call WMoveTo(x+ColInc, y) Call WRelDraw (0., RowInc) End If End If !* Horizontal lines !* Conserved residue on first (top) sequence If (k .eq. 1) Then If (.not. NoBox .and. ChIsUpper(Residue(k,Pos))) Then Call WMoveTo(x, y+RowInc) Call WRelDraw (ColInc, 0.) End If Else !* Conserved residue below non-conserved If (.not. NoBox .and. CaseDiff(Residue(k,Pos), & Residue(k-1,Pos))) Then Call WMoveTo(x, y+RowInc) Call WRelDraw (ColInc, 0.) End If End If If (k .eq. MSQ.NSeqs) Then !* Conserved residue on last (bottom) sequence If (.not. NoBox .and. - 1 ChIsUpper(Residue(MSQ.NSeqs,Pos))) Then Call WMoveTo(x, y) Call WRelDraw (ColInc, 0.) End If !* numbering above If (NumberTop) Then If (Mod(TruePos(TopSeq),10) .eq. 0) Then If ( (TopSeq .eq. CSeq) .or. & (ChIsAlpha( Residue(TopSeq,Pos))) ) Then Call WMoveTo(xt, Numyt) Call WPlotF ('%d\c', TruePos(TopSeq)) End If End If End If !* star-marked positions If (UseStar) Then If (StarChar(TruePos(StarSeq)) .ne. Char(0)) Then If ( (StarSeq .eq. CSeq) .or. & (ChIsAlpha(Residue(StarSeq,Pos))) ) Then Call WMoveTo(xt, Staryt) Call WPlotF('%c\c',StarChar(TruePos(StarSeq))) End If End If End If End If End Do ! k = 1, MSQ.NSeqs !* the consensus If (Consensus) Then yt = yt - RowInc - RowInc y = y - RowInc - RowInc Call WMoveTo(xt, yt) If (ChIsAlpha(Residue(CSeq,Pos))) Then Call WPlotF('%c\c', & Residue(CSeq,Pos)) ! original case Else Call WPlotF('-\c') End If End If End Do ! end of line !* Name of sequence plotted on left side !* Position in sequence plotted on right side If (Consensus) Then If (Number) Then Call WTextOrg (2) Call WMoveTo (Numxt, yt) Call WPlotF('%5d\c',TruePos(CSeq)) End If If (Name) Then Call WTextOrg (8) Call WCHeight(NameHeight) Call WMoveTo (Namext, yt) Call WPlotF('%s\c',MSQ.Name(1,CSeq)) Call WCHeight(CHeight) End If End If yt = yt - 2.*RowInc y = y -2.*RowInc Line = Line+1 End Do ! end of alignment Call EWPlotExit() Call EWPlotEnd() Return End !***** Residue **************************************************************** !* !* Returns residue at given position in given sequence, !* or blank if beyond end of sequence. !* !****************************************************************************** Character Function Residue (iseq, ipos) Implicit None Include 'EGenInclude:PrettyPlot.Inc' Integer iseq, ipos If (ipos .gt. MSQ.Len(iseq)) Then Residue = ' ' Else Residue = Seq(MSQ.Start(iseq)+ipos-1) End If Return End ! of Residue !****** COLOR ***************************************************************** !* !* This makes colored output. Colors were proposed by John Ahouse !* of Brandeis University on bionet.software in June 1993. The !* colors are also used in Don Gilbert's SeqApp. !* !* Strictly speaking, Glycine should be "Grey", which is !* not available on Color XWindows (where this was tested) !* !****************************************************************************** Subroutine Color(Residue) Implicit None Include 'EGenInclude:PrettyPlot.Inc' Character Residue(*) Character Red(32), Blue(32), Green(32), Yellow(32) Character Violet(32), Black(32), Cyan(32), Orange(32) Logical FirstCall /.true./ Integer CIStrChar If (FirstCall) Then Call ECLGetStr('BLACK', 'AVLIG', Black) ! Oily Call ECLGetStr('GREEN', 'NQ', Green) ! Rhyme with green Call ECLGetStr('BLUE', 'RKH', Blue) ! Basic litmus test Call ECLGetStr('RED', 'DE', Red) ! Acidic litmus test Call ECLGetStr('CYAN', 'ST', Cyan) ! Hydroxyl watercolour Call ECLGetStr('YELLOW', 'CM', Yellow) ! Yellow sulfur Call ECLGetStr('VIOLET', 'P', Violet) ! Purple for proline Call ECLGetStr('ORANGE', 'FWY', Orange) ! Orange aromatics FirstCall = .false. End If Call WNewColor(1) ! default to black If (CIStrChar(Black, Residue) .ne. 0) Call WNewColor(1) If (CIStrChar(Green, Residue) .ne. 0) Call WNewColor(2) If (CIStrChar(Blue, Residue) .ne. 0) Call WNewColor(3) If (CIStrChar(Red, Residue) .ne. 0) Call WNewColor(4) If (CIStrChar(Cyan, Residue) .ne. 0) Call WNewColor(5) If (CIStrChar(Violet, Residue) .ne. 0) Call WNewColor(6) If (CIStrChar(Yellow, Residue) .ne. 0) Call WNewColor(7) If (CIStrChar(Orange, Residue) .ne. 0) Call WNewColor(8) Return End ! of Color !****** CCOLOR **************************************************************** !* !* This makes Identity/Similarity/Others color output. !* David Mathog, Biology Division, Caltech !* !****************************************************************************** Subroutine CColor (k, pos, Cmp) Implicit None Include 'EGenInclude:PrettyPlot.Inc' Integer Cmp(32,32) Integer k, pos Integer CCident, CCsimil, CCother Integer roff, coff, i, j character TEST(10) Character ChToUpper, Residue Integer CIStrFind, AlphaToNum, StrToUpper Logical ChIsAlpha Logical FirstCall /.TRUE./ C C On first entry assign Integer color values for three types C of residue. This is really ugly ! Note that the default colors C are NOT set in the .inc file - typos just drop through here to C the defaults C If (FirstCall) Then CCident = 4 !red CCsimil = 3 !green CCother = 1 !black Call ESetColour (CIdentity, CCident) Call ESetColour (CSimilarity, CCsimil) Call ESetColour (COthers, CCother) Call DebugF ('CCident: %d <%s>\n', CCident, CIdentity) Call DebugF ('CCsimil: %d <%s>\n', CCsimil, CSimilarity) Call DebugF ('CCother: %d <%s>\n', CCother, COthers) FirstCall = .false. End If !* first figure out if the residue in question with respect to !* the consensus is: !* IDENTITY, SIMILARITY, OTHERS !* !* Is the consensus an Alpha character? If so, fine, then a !* consensus value for that position exists, otherwise use COthers If (ChIsAlpha(Residue(CSeq, pos))) Then coff = AlphaToNum(Residue(CSeq, pos)) roff = AlphaToNum(Residue(k,pos)) If (coff .eq. roff)then Call WNewColor(CCident) Else If (Cmp(coff,roff) .ge. Threshold) Then Call WNewColor(CCsimil) Else Call WNewColor(CCother) End If Else Call WNewColor(CCother) End If Return End