home *** CD-ROM | disk | FTP | other *** search
/ ftp.uv.es / 2014.11.ftp.uv.es.tar / ftp.uv.es / pub / biologia / distanc_.exe / DISTANCE.PAS < prev    next >
Pascal/Delphi Source File  |  1993-03-18  |  104KB  |  2,962 lines
  1. PROGRAM Distance;    (*3.0*)
  2.  
  3. (****THIS PROGRAM CALCULATES DISTANCES AND OTHER
  4.                              PARAMETERS OF AN ALIGNMENT OF SEQUENCES****)
  5.  
  6.             (****COPYRIGHT JOSE AGUSTIN LOPEZ BUENO****)
  7.             (****     Department of Genetics       ****)
  8.             (****     University of Valencia       ****)
  9.             (****     C/ Doctor Moliner, 50        ****)
  10.             (**** Burjassot-46100, Valencia, SPAIN ****)
  11.  
  12. USES Crt, Dos, UnitDist, Help;
  13.  
  14. CONST enter=#13; esc=#27; nulo =#0; UpArrow =#72;
  15.       DoArrow =#80;  LeArrow =#75;  RiArrow =#77;
  16.       PgUp =#73; PgDo =#81; Home =#71; Fin =#79;
  17.       WindowForeColor= blue;
  18.       WindowTextColor= white;
  19.       WindowEdgeColor= white;
  20.       TitleColor     = yellow;
  21.       Mensaje        = red;
  22.       MaxOptPri      = 10;
  23.       MaxHelp        = 14;
  24.       MaxFor         = 3;
  25.       MaxTable       = 6;
  26.       MaxWhich       = 7;
  27.       MaxOutput      = 3;
  28.       MaxDist        = 6;
  29.  
  30. TYPE tpointer = ^node;
  31.      node     = record
  32.                   base : char;
  33.                   next : tpointer;
  34.                 end;
  35.      tsetseq  = array [1..NumMaxSp] of tpointer;
  36.      tsetkey  = set of char;
  37.      Pant     = array [1..4000] of byte;
  38.      PtrPant  = ^Pant;
  39.  
  40. VAR  setseq                      : tsetseq;
  41.      setkey                      : tsetkey;
  42.      i, baswhich, careful,
  43.        numSp, dist, counterbas,
  44.        TypeOutput, length, format,
  45.        transi, transver, hamm,
  46.        tablewhich                : integer;
  47.      mimodo                      : (mcomando, mmenu);
  48.      readFile, writeFile         : text;
  49.      readpath, writepath         : string;
  50.      dTajNei, vTajNei            : real;
  51.      Modo_Video                  : byte;
  52.      Mono                        : boolean;
  53.      Regs                        : registers;
  54.      wwell, ending, flagreadfile,
  55.        firstime                  : boolean;
  56.      oopt                        : integer;
  57.      kkey, pathch                : char;
  58.      PointInt, PointPant         : PtrPant;
  59.      numventana                  : integer;
  60.      lineaerror, codeerror,
  61.        comerror                  : integer;
  62.      OldExitProcAddress          : pointer;
  63.      setchar                     : set of char;
  64.  
  65.                                                          (*SELECT VIDEO MODE*)
  66. PROCEDURE ModoVideo;
  67.   var parms : registers;
  68.   begin
  69.   parms.AX := $0F00;
  70.   Intr (16, parms);
  71.   Modo_Video := LO (parms.AX);
  72.   case modo_video of
  73.     0,2,5 : mono := true;
  74.     else mono := false;
  75.     end;
  76.   end; (*of procedure*)
  77.  
  78.                                                            (*HIDE THE CURSOR*)
  79. PROCEDURE CursorOff;
  80.   begin
  81.   Regs.AH := $01;
  82.   Regs.CH := $20;
  83.   Intr (16, REGS);
  84.   end; (*of procedure*)
  85.  
  86.                                                            (*SHOW THE CURSOR*)
  87. PROCEDURE CursorOn;
  88.   begin
  89.   ModoVideo;
  90.   case mono of
  91.     false : Regs.CX := $0607;
  92.     true  : Regs.CX := $0C0D;
  93.     end;
  94.   Regs.AX := $100;
  95.   Intr (16, REGS);
  96.   end; (*of procedure*)
  97.  
  98.                                                                     (*SCREEN*)
  99. FUNCTION VidSeg:word;
  100.   begin
  101.   if Mem [$0000:$0449] = 7 then VidSeg := $B000
  102.   else VidSeg := $B800;
  103.   end;
  104.  
  105. PROCEDURE Inicializa_Ptr;
  106.   begin
  107.   New (PointInt);
  108.   New (PointPant);
  109.   PointPant:=Ptr (VidSeg,$0001);
  110.   end;
  111.  
  112.                                                 (*ERROR CODES IMPLEMENTATION*)
  113. {$F+}PROCEDURE MyExitProcedure;{$F-}
  114.   var st: string;
  115.   begin
  116.   if ErrorAddr <> nil then
  117.     begin
  118.     case codeerror of
  119.       0: st:='Undetermined error.';
  120.       1: st:='File cannot be openned.';
  121.       2: st:='Integer value expected.';
  122.       3: st:='Character expected. Possibly wrong input format chosen.';
  123.       4: st:='Maximum number of sequences exceeded.';
  124.       5: st:='Maximum sequence length exceeded.';
  125.       6: st:='Carriage return expected.';
  126.       7: st:='End-of-file expected.';
  127.       8: st:='File cannot be closed.';
  128.       9: st:='String expected.';
  129.      10: st:='Species name expected.';
  130.      11: st:='Empty file.';
  131.      12: st:='Impossible to compute the power function.';
  132.      13: st:='Impossible to do the computation.';
  133.      14: st:='Results cannot be written.';
  134.      15: st:='Wrong character.';
  135.      16: st:='File too large for current memory.';
  136.      20: st:='Jukes-Cantor''s distance cannot be computed.';
  137.      21: st:='Kimura''s 2 par. distance cannot be computed.';
  138.      22: st:='Kimura''s 3 par. distance cannot be computed.';
  139.      23: st:='Kimura''s 4 par. distance cannot be computed.';
  140.      24: st:='Kimura''s 6 par. distance cannot be computed.';
  141.      25: st:='Tajima-Nei''s distance cannot be computed.';
  142.      26: st:='Jukes-Cantor''s variance cannot be computed.';
  143.      27: st:='Kimura''s 2 par. variance cannot be computed.';
  144.      28: st:='Kimura''s 3 par. variance cannot be computed.';
  145.       end;
  146.     textcolor (white);
  147.     textbackground (black);
  148.     cursoron;
  149.     ClrScr;
  150.     writeln ('Runtime error number ', ExitCode, ' has ocurred');
  151.     writeln ('The error address in decimal is ',
  152.               seg(ErrorAddr):5,':',Ofs(ErrorAddr):5);
  153.     writeln (st);
  154.     if codeerror<20 then writeln ('Error in line ', lineaerror);
  155.     ErrorAddr:= nil;
  156.     ExitCode:= 0;
  157.     end;
  158.   ExitProc:= OldExitProcAddress;
  159.   end;
  160.  
  161.                                            (*READING INPUT FROM THE KEYBOARD*)
  162. PROCEDURE ReadingKey (var popcion: char; psetkey: Tsetkey);
  163.   begin
  164.   repeat
  165.     popcion:= readkey;
  166.     if (popcion=nulo) then popcion:= readkey
  167.     else begin
  168.          if ((popcion<>nulo) and (NOT(popcion in psetkey))) then popcion:='(';
  169.          end;
  170.   until (popcion in psetkey);
  171.   end;
  172.                                                                   (*BEEP!!!!*)
  173. PROCEDURE Beep (frec, duracio: integer);
  174.   begin
  175.   Sound (frec);
  176.   Delay (duracio);
  177.   NoSound;
  178.   end;
  179.  
  180.                                              (*MAKE ANOTHER TYPE OF WRITE*)
  181. PROCEDURE WriteXY (px1, py1: integer; c: char);
  182.   begin
  183.   GotoXY (px1, py1);
  184.   write (c);
  185.   end;
  186.  
  187.                                                (*MAKE ANOTHER TYPE OF WINDOW*)
  188. PROCEDURE OtherWindow (x1, y1, x2, y2: integer);
  189.   var i:integer;
  190.       iu, id, du, dd, t, b: char;
  191.   begin
  192.   iu:= '╔'; id:= '╚'; du:= '╗'; dd:= '╝'; t:= '═'; b:= '║';
  193.   if numventana=1 then textcolor (red) else textcolor(WindowEdgeColor);
  194.   textbackground(WindowForeColor);
  195.   writexy (x1, y1, iu);
  196.   writexy (x2, y1, du);
  197.   writexy (x1, y2, id);
  198.   writexy (x2, y2, dd);
  199.   for i:= x1+1 to x2-1 do
  200.     begin
  201.     writexy (i, y1, t);
  202.     writexy (i, y2, t);
  203.     end;
  204.   for i:= y1+1 to y2-1 do
  205.     begin
  206.     writexy (x1, i, b);
  207.     writexy (x2, i, b);
  208.     end;
  209.   window(x1+1,y1+1,x2-1,y2-1);
  210.   clrscr;
  211.   end;
  212.  
  213.                                                             (*PROGRAM SCREEN*)
  214. PROCEDURE Presentation;
  215.   begin
  216.   window (1, 1, 80, 25);
  217.   textbackground (black);
  218.   textcolor (green);
  219.   clrscr;
  220.   beep (300,100);
  221.   writeln;
  222.   writeln;
  223.   writeln;
  224.   writeln;
  225.   writeln;
  226.   writeln;
  227.   writeln;
  228.   writeln;
  229.   writeln ('                 Copyright José Agustín López Bueno    1993');
  230.   writeln;
  231.   writeln ('                                DISTANCE');
  232.   writeln;
  233.   writeln;
  234.   textbackground (black);
  235.   textcolor (white+blink);
  236.   gotoxy (26, 14);
  237.   writeln;
  238.   writeln;
  239.   writeln;
  240.   textcolor (titlecolor);
  241.   textbackground (windowforecolor);
  242.   delay (1000);
  243.   end; (*of procedure*)
  244.  
  245.                                           (*CHECK EXISTENCE OF RESULTS FILE*)
  246. PROCEDURE ProcCareful (var pcareful: integer);
  247.   const MaxCareful=3;
  248.   var well : boolean;
  249.       opt  : integer;
  250.       key  : char;
  251.   begin
  252.   well := false;
  253.   Beep (300,100);
  254.   OtherWindow (20, 7, 56, 15);
  255.   TextBackGround (WindowForeColor);
  256.   clrscr;
  257.   opt:= 1;
  258.   repeat
  259.     GotoXY(2,1); begin
  260.                  textcolor (TitleColor);
  261.                  Write ('WARNING! THIS FILE ALREADY EXISTS: ');
  262.                  textcolor (green);
  263.                  end;
  264.     GotoXY(2,2);
  265.     GotoXY(2,3); begin
  266.                  if opt=1 then begin
  267.                                textbackground (black);
  268.                                textcolor (white);
  269.                                end;
  270.                  Write ('Create a new file with that name.');
  271.                  textbackground (WindowForeColor); textcolor (green);
  272.                  end;
  273.     GotoXY(2,4); begin
  274.                  if opt=2 then begin
  275.                                textbackground (black);
  276.                                textcolor (white);
  277.                                end;
  278.                  Write ('Add data to the end of that file.');
  279.                  textbackground (WindowForeColor); textcolor (green);
  280.                  end;
  281.     GotoXY(2,5); begin
  282.                  if opt=3 then begin
  283.                                textbackground (black);
  284.                                textcolor (white);
  285.                                end;
  286.                  Write ('Cancel.');
  287.                  textbackground (WindowForeColor); textcolor (green);
  288.                  end;
  289.     ReadingKey (key, setkey);
  290.     case key of
  291.       UpArrow: begin Dec (opt); if opt<1 then opt:= MaxCareful; end;
  292.       DoArrow: begin Inc (opt); if opt>MaxCareful then opt:=1; end;
  293.       Enter  : well:= true;
  294.     end;
  295.   until well=true;
  296.   pcareful:= opt;
  297.   textbackground (black);
  298.   textcolor (white);
  299.   window (1, 1, 80, 25);
  300.   end; (*of procedure*)
  301.  
  302.  
  303. FUNCTION FileExists (path:string):boolean;
  304.   var f: text;
  305.   begin
  306.   {$I-} assign (f, path); reset (f); close (f); {$I+}
  307.   FileExists:= ((IOResult = 0) and (path <> ''));
  308.   end;
  309.  
  310.                               (*CHOOSE THE READING PATH OF THE SEQUENCE FILE*)
  311. PROCEDURE PathReadFile;
  312.   var well, existe   : boolean;
  313.   begin
  314.   well := false;
  315.   pathch:= Esc;
  316.   Beep (300,100);
  317.   window (1, 1, 80, 25);
  318.   OtherWindow (10, 9, 70, 14);
  319.   repeat
  320.     TextBackGround (WindowForeColor);
  321.     TextColor (TitleColor);
  322.     clrscr;
  323.     gotoXY (1,1);
  324.     Write ('  WRITE THE PATH AND NAME OF THE DNA ALIGNMENT FILE:');
  325.     gotoXY (1,3);
  326.     Write ('    >>>');
  327.     cursoron;
  328.     textcolor (WindowTextColor);
  329.     Readln (readpath);
  330.     cursoroff;
  331.     existe:= FileExists (readpath);
  332.     if existe=false then
  333.       begin
  334.       well := false;
  335.       TextColor (Mensaje);
  336.       ClrScr;
  337.       beep (300, 100);
  338.       writeln;
  339.       writeln ('             ¡¡¡  WRONG PATH AND/OR FILE NAME  !!!');
  340.       writeln ('           Press Esc to exit, anyother key to continue');
  341.       pathch:= ReadKey;
  342.       if pathch=Esc then exit;
  343.       clrscr;
  344.       TextColor (WindowTextColor);
  345.       end
  346.     else begin well := true; pathch:=' '; end;
  347.   until well = true;
  348.   cursoroff;
  349.   textbackground (windowforecolor);
  350.   textcolor (windowtextcolor);
  351.   window (1, 1, 80, 25);
  352.   end; (*of procedure*)
  353.  
  354.                               (*CHOOSE THE WRITTING PATH OF THE RESULTS FILE*)
  355. PROCEDURE PathWriteFile;
  356.   var well, existe : boolean;
  357.       point2       : ptrPant;
  358.   begin
  359.   repeat
  360.     well := false;
  361.     beep (300,100);
  362.     window (1, 1, 80, 25);
  363.     OtherWindow (10, 9, 70, 14);
  364.     TextBackGround (WindowForeColor);
  365.     TextColor (TitleColor);
  366.     ClrScr;
  367.     writeln (' WRITE THE PATH AND NAME OF THE RESULTS FILE:');
  368.     writeln;
  369.     write ('    >>>');
  370.     cursoron;
  371.     textcolor (WindowTextColor);
  372.     readln (writepath);
  373.     if writepath='' then writepath:= 'sequence.rst';
  374.     cursoroff;
  375.     existe:= FileExists (writepath);
  376.     if existe=true then
  377.       begin
  378.       new (point2);
  379.       point2^:= pointPant^;
  380.       well:= false;
  381.       window (1, 1, 80, 25);
  382.       ProcCareful (careful);
  383.       if careful<>3 then well:= true;
  384.       pointPant^:= point2^;
  385.       end
  386.     else begin careful:= 1; well:= true; end;
  387.   until well = true;
  388.   cursoroff;
  389.   textbackground (windowforecolor);
  390.   textcolor (windowtextcolor);
  391.   window (1, 1, 80, 25);
  392.   end; (*of procedure*)
  393.  
  394.                                                                (*HELP SCREEN*)
  395. PROCEDURE HelpScreen;
  396.   var well : boolean;
  397.       opt  : integer;
  398.       key  : char;
  399.       psetkey: set of char;
  400.   begin
  401.   psetkey:= [Esc, PgUp, PgDo, Home, Fin];
  402.   well := false;
  403.   opt:= 1;
  404.   window (1, 1, 80, 25);
  405.   OtherWindow (2, 2, 79, 24);
  406.   repeat
  407.     Beep (300,100);
  408.     TextBackGround (WindowForeColor);
  409.     TextColor (green);
  410.     ClrScr;
  411.     textbackground (green);
  412.     textcolor (red);
  413.     GotoXY(35,1); Writeln ('HELP:');
  414.     TextBackGround (WindowForeColor);
  415.     TextColor (green);
  416.     case opt of
  417.       1: HelpPag1;  (*INDEX*)
  418.       2: HelpPag2;  (*Ex. Format Phy. New*)
  419.       3: HelpPag3;  (*Ex. Format Phy. Old*)
  420.       4: HelpPag4;  (*Ex. Format MSF*)
  421.       5: HelpPag5;  (*Methods to compute distances, JC*)
  422.       6: HelpPag6;  (*Methods to compute distances, K2*)
  423.       7: HelpPag7;  (*Methods to compute distances, K3*)
  424.       8: HelpPag8;  (*Methods to compute distances, K4*)
  425.       9: HelpPag9;  (*Methods to compute distances, K6*)
  426.      10: HelpPag10; (*Methods to compute distances, TN*)
  427.      11: HelpPag11; (*Bases to use*)
  428.      12: HelpPag12; (*Code tables*)
  429.      13: HelpPag13; (*Output*)
  430.      14: HelpPag14; (*Some important notes, Future developments*)
  431.       end;
  432.     textbackground (green);
  433.     textcolor (red);
  434.     case opt of
  435.       2,3,4,5,6,7,
  436.       8,9,10,11,12,13: begin GotoXY(10,21); Write ('Press PgUp, PgDn, Home or End for more help. Esc to Exit.'); end;
  437.       1: begin GotoXY(10,21); Write ('Press PgDn or End for more help. Esc to Exit.'); end;
  438.       14: begin GotoXY(10,21); Write ('Press PgUp or Home for more help. Esc to Exit.'); end;
  439.       end;
  440.     ReadingKey (key, psetkey);
  441.     case key of
  442.       PgUp: begin Dec (opt); if opt<1 then opt:= 1; end;
  443.       PgDo: begin Inc (opt); if opt>MaxHelp then opt:= MaxHelp; end;
  444.       Home: opt:= 1;
  445.       Fin: opt:= MaxHelp;
  446.       Esc : well:= true;
  447.     end;
  448.   until well=true;
  449.   textbackground (windowforecolor);
  450.   textcolor (windowtextcolor);
  451.   window (1, 1, 80, 25);
  452.   end; (*of procedure*)
  453.  
  454.                                                     (*CHOOSE THE FILE FORMAT*)
  455. PROCEDURE AskFormat (var pformat: integer);
  456.   var well : boolean;
  457.       opt  : integer;
  458.       key  : char;
  459.   begin
  460.   well := false;
  461.   Beep (300,100);
  462.   window (1, 1, 80, 25);
  463.   OtherWindow (18, 10, 61, 17);
  464.   TextBackGround (WindowForeColor);
  465.   TextColor (green);
  466.   clrscr;
  467.   opt:= pformat;
  468.   repeat
  469.     GotoXY(2,1); begin
  470.                  textcolor (TitleColor);
  471.                  Write ('  FORMAT OF YOUR ALIGNED FILE:   ');
  472.                  textcolor (green);
  473.                  end;
  474.     GotoXY(2,2);
  475.     GotoXY(2,3); begin
  476.                  if opt=1 then begin
  477.                                textbackground (black);
  478.                                textcolor (white);
  479.                                end;
  480.                  Write ('Interleaved (Phylip version 3.3.).');
  481.                  textbackground (WindowForeColor); textcolor (green);
  482.                  end;
  483.     GotoXY(2,4); begin
  484.                  if opt=2 then begin
  485.                                textbackground (black);
  486.                                textcolor (white);
  487.                                end;
  488.                  Write ('Aligned (Phylip older versions).');
  489.                  textbackground (WindowForeColor); textcolor (green);
  490.                  end;
  491.     GotoXY(2,5); begin
  492.                  if opt=3 then begin
  493.                                textbackground (black);
  494.                                textcolor (white);
  495.                                end;
  496.                  Write ('MSF format (GCG''s PILEUP program output).');
  497.                  textbackground (WindowForeColor); textcolor (green);
  498.                  end;
  499.     ReadingKey (key, setkey);
  500.     case key of
  501.       UpArrow: begin Dec (opt); if opt<1 then opt:= MaxFor; end;
  502.       DoArrow: begin Inc (opt); if opt>MaxFor then opt:=1; end;
  503.       Enter  : begin well:= true; pformat:= opt; end;
  504.       Esc    : well:= true;
  505.     end;
  506.   until well=true;
  507.   textbackground (windowforecolor);
  508.   textcolor (windowtextcolor);
  509.   window (1, 1, 80, 25);
  510.   end; (*of procedure*)
  511.  
  512. PROCEDURE AskCodonTableWhich (var ptablewhich: integer);
  513.   var well : boolean;
  514.       opt  : integer;
  515.       key  : char;
  516.   begin
  517.   well := false;
  518.   Beep (300,100);
  519.   window (1, 1, 80, 25);
  520.   OtherWindow (20, 10, 59, 20);
  521.   TextBackGround (WindowForeColor);
  522.   TextColor (green);
  523.   clrscr;
  524.   opt:= ptablewhich;
  525.   repeat
  526.     GotoXY(2,1); begin
  527.                  textcolor (TitleColor);
  528.                  Write (' CHOOSE THE TRANSLATION CODE TABLE: ');
  529.                  textcolor (green);
  530.                  end;
  531.     GotoXY(2,2);
  532.     GotoXY(2,3); begin
  533.                  if opt=1 then begin
  534.                                textbackground (black);
  535.                                textcolor (white);
  536.                                end;
  537.                  Write ('DON''T MAKE THESE COMPUTATIONS.');
  538.                  textbackground (WindowForeColor); textcolor (green);
  539.                  end;
  540.     GotoXY(2,4); begin
  541.                  if opt=2 then begin
  542.                                textbackground (black);
  543.                                textcolor (white);
  544.                                end;
  545.                  Write ('STANDARD GENETIC CODE.');
  546.                  textbackground (WindowForeColor); textcolor (green);
  547.                  end;
  548.     GotoXY(2,5); begin
  549.                  if opt=3 then begin
  550.                                textbackground (black);
  551.                                textcolor (white);
  552.                                end;
  553.                  Write ('DROSOPHILA MITOCHONDRIAL CODE.');
  554.                  textbackground (WindowForeColor); textcolor (green);
  555.                  end;
  556.     GotoXY(2,6); begin
  557.                  if opt=4 then begin
  558.                                textbackground (black);
  559.                                textcolor (white);
  560.                                end;
  561.                  Write ('YEAST MITOCHONDRIAL CODE.');
  562.                  textbackground (WindowForeColor); textcolor (green);
  563.                  end;
  564.     GotoXY(2,7); begin
  565.                  if opt=5 then begin
  566.                                textbackground (black);
  567.                                textcolor (white);
  568.                                end;
  569.                  Write ('MAMMALIAN MITOCHONDRIAL CODE.');
  570.                  textbackground (WindowForeColor); textcolor (green);
  571.                  end;
  572.     GotoXY(2,8); begin
  573.                  if opt=6 then begin
  574.                                textbackground (black);
  575.                                textcolor (white);
  576.                                end;
  577.                  Write ('CILIATED CODE.');
  578.                  textbackground (WindowForeColor); textcolor (green);
  579.                  end;
  580.     ReadingKey (key, setkey);
  581.     case key of
  582.       UpArrow: begin Dec (opt); if opt<1 then opt:= MaxTable; end;
  583.       DoArrow: begin Inc (opt); if opt>MaxTable then opt:=1; end;
  584.       Enter  : begin well:= true; ptablewhich:= opt; end;
  585.       Esc    : well:= true;
  586.     end;
  587.   until well=true;
  588.   textbackground (windowforecolor);
  589.   textcolor (windowtextcolor);
  590.   window (1, 1, 80, 25);
  591.   end; (*of procedure*)
  592.  
  593.                                         (*WHICH BASES TO USE IN COMPUTATIONS*)
  594. PROCEDURE AskWhich (var pbaswhich: integer);
  595.   var well : boolean;
  596.       opt  : integer;
  597.       key  : char;
  598.   begin
  599.   well := false;
  600.   Beep (300,100);
  601.   window (1, 1, 80, 25);
  602.   OtherWindow (24, 7, 54, 18);
  603.   TextBackGround (WindowForeColor);
  604.   TextColor (green);
  605.   clrscr;
  606.   opt:= pbaswhich;
  607.   repeat
  608.     GotoXY(2,1); begin
  609.                  textcolor (TitleColor);
  610.                  Write ('BASES IN EACH CODON TO USE: ');
  611.                  textcolor (green);
  612.                  end;
  613.     GotoXY(2,2);
  614.     GotoXY(2,3); begin
  615.                  if opt=1 then begin
  616.                                textbackground (black);
  617.                                textcolor (white);
  618.                                end;
  619.                  Write ('ALL THE BASES.');
  620.                  textbackground (WindowForeColor); textcolor (green);
  621.                  end;
  622.     GotoXY(2,4); begin
  623.                  if opt=2 then begin
  624.                                textbackground (black);
  625.                                textcolor (white);
  626.                                end;
  627.                  Write ('FIRST AND SECOND BASES.');
  628.                  textbackground (WindowForeColor); textcolor (green);
  629.                  end;
  630.     GotoXY(2,5); begin
  631.                  if opt=3 then begin
  632.                                textbackground (black);
  633.                                textcolor (white);
  634.                                end;
  635.                  Write ('FIRST AND THIRD BASES.');
  636.                  textbackground (WindowForeColor); textcolor (green);
  637.                  end;
  638.     GotoXY(2,6); begin
  639.                  if opt=4 then begin
  640.                                textbackground (black);
  641.                                textcolor (white);
  642.                                end;
  643.                  Write ('SECOND AND THIRD BASES.');
  644.                  textbackground (WindowForeColor); textcolor (green);
  645.                  end;
  646.     GotoXY(2,7); begin
  647.                  if opt=5 then begin
  648.                                textbackground (black);
  649.                                textcolor (white);
  650.                                end;
  651.                  Write ('FIRST BASE.');
  652.                  textbackground (WindowForeColor); textcolor (green);
  653.                  end;
  654.     GotoXY(2,8); begin
  655.                  if opt=6 then begin
  656.                                textbackground (black);
  657.                                textcolor (white);
  658.                                end;
  659.                  Write ('SECOND BASE.');
  660.                  textbackground (WindowForeColor); textcolor (green);
  661.                  end;
  662.     GotoXY(2,9); begin
  663.                  if opt=7 then begin
  664.                                textbackground (black);
  665.                                textcolor (white);
  666.                                end;
  667.                  Write ('THIRD BASE.');
  668.                  textbackground (WindowForeColor); textcolor (green);
  669.                  end;
  670.     ReadingKey (key, setkey);
  671.     case key of
  672.       UpArrow: begin Dec (opt); if opt<1 then opt:= MaxWhich; end;
  673.       DoArrow: begin Inc (opt); if opt>MaxWhich then opt:=1; end;
  674.       Enter  : begin well:= true; pbaswhich:= opt; end;
  675.       Esc    : well:= true;
  676.     end;
  677.   until well=true;
  678.   textbackground (windowforecolor);
  679.   textcolor (windowtextcolor);
  680.   window (1, 1, 80, 25);
  681.   end; (*of procedure*)
  682.  
  683.                                                          (*CHOOSE THE OUTPUT*)
  684. PROCEDURE AskOutput (var ptypeoutput: integer);
  685.   var well : boolean;
  686.       opt  : integer;
  687.       key  : char;
  688.   begin
  689.   well := false;
  690.   Beep (300,100);
  691.   window (1, 1, 80, 25);
  692.   OtherWindow (23, 9, 56, 16);
  693.   TextBackGround (WindowForeColor);
  694.   TextColor (green);
  695.   clrscr;
  696.   opt:= ptypeoutput;
  697.   repeat
  698.     GotoXY(2,1); begin
  699.                  textcolor (TitleColor);
  700.                  Write ('          OUTPUT:   ');
  701.                  textcolor (green);
  702.                  end;
  703.     GotoXY(2,2);
  704.     GotoXY(2,3); begin
  705.                  if opt=1 then begin
  706.                                textbackground (black);
  707.                                textcolor (white);
  708.                                end;
  709.                  Write ('LARGE (all the matrices). ');
  710.                  textbackground (WindowForeColor); textcolor (green);
  711.                  end;
  712.     GotoXY(2,4); begin
  713.                  if opt=2 then begin
  714.                                textbackground (black);
  715.                                textcolor (white);
  716.                                end;
  717.                  Write ('BRIEF (only distances matrix).');
  718.                  textbackground (WindowForeColor); textcolor (green);
  719.                  end;
  720.     GotoXY(2,5); begin
  721.                  if opt=3 then begin
  722.                                textbackground (black);
  723.                                textcolor (white);
  724.                                end;
  725.                  Write ('Output for FITCH AND KITSCH.');
  726.                  textbackground (WindowForeColor); textcolor (green);
  727.                  end;
  728.     ReadingKey (key, setkey);
  729.     case key of
  730.       UpArrow: begin Dec (opt); if opt<1 then opt:= MaxOutput; end;
  731.       DoArrow: begin Inc (opt); if opt>MaxOutput then opt:=1; end;
  732.       Enter  : begin well:= true; ptypeoutput:= opt; end;
  733.       Esc    : well:= true;
  734.     end;
  735.   until well=true;
  736.   textbackground (windowforecolor);
  737.   textcolor (windowtextcolor);
  738.   window (1, 1, 80, 25);
  739.   end; (*of procedure*)
  740.  
  741.                                           (*WHICH DISTANCE TO COMPUTE*)
  742. PROCEDURE AskMethod (var pdist: integer);
  743.   var well : boolean;
  744.       opt  : integer;
  745.       key  : char;
  746.   begin
  747.   well := false;
  748.   Beep (300,100);
  749.   window (1, 1, 80, 25);
  750.   OtherWindow (21, 9, 57, 19);
  751.   TextBackGround (WindowForeColor);
  752.   TextColor (green);
  753.   clrscr;
  754.   opt:= pdist;
  755.   repeat
  756.     GotoXY(2,1); begin
  757.                  textcolor (TitleColor);
  758.                  Write ('METHOD TO COMPUTE DISTANCES: ');
  759.                  textcolor (green);
  760.                  end;
  761.     GotoXY(2,2);
  762.     GotoXY(2,3); begin
  763.                  if opt=1 then begin
  764.                                textbackground (black);
  765.                                textcolor (white);
  766.                                end;
  767.                  Write ('JUKES-CANTOR.');
  768.                  textbackground (WindowForeColor); textcolor (green);
  769.                  end;
  770.     GotoXY(2,4); begin
  771.                  if opt=2 then begin
  772.                                textbackground (black);
  773.                                textcolor (white);
  774.                                end;
  775.                  Write ('KIMURA''S TWO PARAMETERS.');
  776.                  textbackground (WindowForeColor); textcolor (green);
  777.                  end;
  778.     GotoXY(2,5); begin
  779.                  if opt=3 then begin
  780.                                textbackground (black);
  781.                                textcolor (white);
  782.                                end;
  783.                  Write ('KIMURA''S THREE PARAMETERS.');
  784.                  textbackground (WindowForeColor); textcolor (green);
  785.                  end;
  786.     GotoXY(2,6); begin
  787.                  if opt=4 then begin
  788.                                textbackground (black);
  789.                                textcolor (white);
  790.                                end;
  791.                  Write ('KIMURA''S FOUR PARAMETERS.');
  792.                  textbackground (WindowForeColor); textcolor (green);
  793.                  end;
  794.     GotoXY(2,7); begin
  795.                  if opt=5 then begin
  796.                                textbackground (black);
  797.                                textcolor (white);
  798.                                end;
  799.                  Write ('KIMURA''S SIX PARAMETERS.');
  800.                  textbackground (WindowForeColor); textcolor (green);
  801.                  end;
  802.     GotoXY(2,8); begin
  803.                  if opt=6 then begin
  804.                                textbackground (black);
  805.                                textcolor (white);
  806.                                end;
  807.                  Write ('TAJIMA AND NEI''S FOUR PARAMETERS.');
  808.                  textbackground (WindowForeColor); textcolor (green);
  809.                  end;
  810.     ReadingKey (key, setkey);
  811.     case key of
  812.       UpArrow: begin Dec (opt); if opt<1 then opt:= MaxDist; end;
  813.       DoArrow: begin Inc (opt); if opt>MaxDist then opt:=1; end;
  814.       Enter  : begin well:= true; pdist:= opt; end;
  815.       Esc    : well:= true;
  816.     end;
  817.   until well=true;
  818.   textbackground (windowforecolor);
  819.   textcolor (windowtextcolor);
  820.   window (1, 1, 80, 25);
  821.   end; (*of procedure*)
  822.  
  823.                                                      (*FREE THE POINTER LIST*)
  824. PROCEDURE FreeList;
  825.   var i: integer;
  826.       p: tpointer;
  827.   begin
  828.   for i:= 1 to NumMaxSp do
  829.     begin
  830.     p:= setseq [i];
  831.     while p <> nil do
  832.       begin
  833.       setseq [i]:= p^.next;
  834.       dispose (p);
  835.       p:= setseq [i];
  836.       end;
  837.     end;
  838.   end; (*of procedure*)
  839.  
  840.                                           (*SEVERAL PROCEDURES WITH POINTERS*)
  841. PROCEDURE MakeList;
  842.   var ind1 : integer;
  843.   begin
  844.   for ind1 := 1 to NumMaxSp do
  845.     begin
  846.     setseq [ind1] := nil;
  847.     end;
  848.   end; (*of procedure*)
  849.  
  850. PROCEDURE InsertEnd (var list : tpointer; x : char);
  851.   var p, q : tpointer;
  852.   begin
  853.   codeerror:= 16;
  854.   new (p);
  855.   p^.base := x;
  856.   p^.next := nil;
  857.   if  list = nil then list := p else
  858.     begin
  859.     q := list;
  860.     while q^.next <> nil do q := q^.next;
  861.     q^.next := p;
  862.     end;
  863.   codeerror:= 0;
  864.   end; (*of procedure*)
  865.  
  866.                                                         (*POWER OF TWO REALS*)
  867. FUNCTION Power (expon, bas: real):real;
  868.   begin
  869.   codeerror:= 12;
  870.   Power:= exp (expon*ln(bas));
  871.   codeerror:= 0;
  872.   end;
  873.  
  874.                         (*COMPUTE JUKES AND CANTOR'S DISTANCE, 1 PARAMETER*)
  875. FUNCTION dJukesCantor (flong:integer; xac, xag, xat, xtg, xcg, xtc, x_a, x_c, x_g, x_t : real): real;
  876.   var fd : real;
  877.   begin
  878.   codeerror:= 20;
  879.   fd := (xac + xag + xat + xtg + xcg + xtc)/flong;
  880.   dJukesCantor := (-3/4)*ln(1-((4/3)*fd));
  881.   codeerror:= 0;
  882.   end; (*of function*)
  883.  
  884.                                      (*COMPUTE JUKES AND CANTOR'S VARIANCE*)
  885. FUNCTION vJukesCantor (flong:integer; xac, xag, xat, xtg, xcg, xtc, x_a, x_c, x_g, x_t : real): real;
  886.   var p : real;
  887.   begin
  888.   codeerror:= 26;
  889.   p := (xac + xag + xat + xtg + xcg + xtc)/flong;
  890.   vJukesCantor := (9*p*(1-p))/((sqr(3-(4*p)))*flong);
  891.   codeerror:= 0;
  892.   end; (*of function*)
  893.  
  894. FUNCTION FormJC (ps:real): real;
  895.   begin
  896.   codeerror:= 13;
  897.   FormJC := (-3/4)*ln(1-((4/3)*ps));
  898.   codeerror:= 0;
  899.   end;
  900.  
  901.                                  (*COMPUTE KIMURA'S DISTANCE, 2 PARAMETERS*)
  902. FUNCTION dKimura2 (flong:integer; xac, xag, xat, xtg, xcg, xtc, x_a, x_c, x_g, x_t : real) : real;
  903.   var fp, fq : real;
  904.   begin
  905.   codeerror:= 21;
  906.   fp := (xtc + xag)/flong;
  907.   fq := (xat + xcg + xtg + xac)/flong;
  908.   dKimura2 := (-1/2) * ln ((1-(2*fp)-fq)*(sqrt(1-(2*fq))));
  909.   codeerror:= 0;
  910.   end; (*of function*)
  911.  
  912.                                  (*COMPUTE KIMURA'S VARIANCE, 2 PARAMETERS*)
  913. FUNCTION vKimura2 (flong:integer; xac, xag, xat, xgt, xcg, xct, x_a, x_c, x_g, x_t : real) : real;
  914.   var a, b, p, q : real;
  915.   begin
  916.   codeerror:= 27;
  917.   p := (xct + xag)/flong;
  918.   q := (xat + xcg + xgt + xac)/flong;
  919.   a := (1/(1-(2*p)-q));
  920.   b := (1/2)*((1/(1-(2*p)-q)+(1/(1-(2*q)))));
  921.   vKimura2 := (1/flong)*((sqr(a)*p)+(sqr(b)*q)-sqr((a*p)+(b*q)));
  922.   codeerror:= 0;
  923.   end; (*of function*)
  924.  
  925.                                  (*COMPUTE KIMURA'S DISTANCE, 3 PARAMETERS*)
  926. FUNCTION dKimura3 (flong:integer; xac, xag, xat, xtg, xcg, xtc, x_a, x_c, x_g, x_t : real) : real;
  927.   var fp, fq, fr : real;
  928.   begin
  929.   codeerror:= 22;
  930.   fp := (xtc + xag)/flong;
  931.   fq := (xat + xcg)/flong;
  932.   fr := (xtg + xac)/flong;
  933.   dKimura3 := (-1/4)*ln((1-(2*fp)-(2*fq))*(1-(2*fp)-(2*fr))*(1-(2*fq)-(2*fr)));
  934.   codeerror:= 0;
  935.   end; (*of function*)
  936.  
  937.                                  (*COMPUTE KIMURA'S VARIANCE, 3 PARAMETERS*)
  938. FUNCTION vKimura3 (flong:integer; xac, xag, xat, xtg, xcg, xtc, x_a, x_c, x_g, x_t : real) : real;
  939.   var fp, fq, fr, a, b, c, C12, C13, C23: real;
  940.   begin
  941.   codeerror:= 28;
  942.   fp := (xtc + xag)/flong;
  943.   fq := (xat + xcg)/flong;
  944.   fr := (xtg + xac)/flong;
  945.   C12 := 1/(1-(2*fp)-(2*fq));
  946.   C13 := 1/(1-(2*fp)-(2*fr));
  947.   C23 := 1/(1-(2*fq)-(2*fr));
  948.   a := (C12 + C13)/2;
  949.   b := (C12 + C23)/2;
  950.   c := (C13 + C23)/2;
  951.   vKimura3 := (1/flong)*((sqr(a)*fp)+(sqr(b)*fq)+(sqr(c)*fr))-sqr((a*fp)+(b*fq)+(c*fr));
  952.   codeerror:= 0;
  953.   end;
  954.  
  955.                                  (*COMPUTE KIMURA'S DISTANCE, 4 PARAMETERS*)
  956. FUNCTION dKimura4 (flong:integer; xaa, xac, xag, xat, xgg, xgt, xcg, xtt, xct, xcc, x_a, x_c, x_g, x_t : real) : real;
  957.   var w, S13, Q1, S24, Q2, fp, fr: real;
  958.       m1, m2, x: real;
  959.   begin
  960.   codeerror:= 23;
  961.   xaa := xaa/flong; xac := xac/flong; xag:= xag/flong; xat:= xat/flong;
  962.   xgg := xgg/flong; xgt := xgt/flong; xcg:= xcg/flong; xtt:= xtt/flong;
  963.   xct := xct/flong; xcc := xcc/flong; x_a:= x_a/flong; x_c:= x_c/flong;
  964.   x_g := x_g/flong; x_t := x_t/flong;
  965.   w := xaa + xtt + xat + (xag + xac + xct + xgt)/2;
  966.   S13 := xaa + xtt;
  967.   S24 := xcc + xgg;
  968.   Q1 := xat; Q2 := xcg;
  969.   fp := xct + xag;
  970.   fr := xgt + xac;
  971.   m1 := (((S13-Q1)*(S24-Q2))-sqr((fp-fr)/2))/(w*(1-w));
  972.   m2 := 1-((fp+fr)/(2*w*(1-w)));
  973.   x := (8*w*(1-w))-1;
  974.   m2 := power (x, m2);
  975.   dKimura4 := (-1/4)*ln(m1*m2);
  976.   codeerror:= 0;
  977.   end;
  978.  
  979.                                  (*COMPUTE KIMURA'S DISTANCE, 6 PARAMETERS*)
  980. FUNCTION dKimura6 (flong:integer; xaa, xac, xag, xat, xgg, xgt, xcg, xtt, xct, xcc, x_a, x_c, x_g, x_t : real) : real;
  981.   var p, q, qa, qt, qc, qg, b1,
  982.       f12, e12, f34, e34, k1, k2, k3,
  983.       a, b                             : real;
  984.   begin
  985.   codeerror:= 24;
  986.   xaa := xaa/flong; xac := xac/flong; xag:= xag/flong; xat:= xat/flong;
  987.   xgg := xgg/flong; xgt := xgt/flong; xcg:= xcg/flong; xtt:= xtt/flong;
  988.   xct := xct/flong; xcc := xcc/flong; x_a:= x_a/flong; x_c:= x_c/flong;
  989.   x_g := x_g/flong; x_t := x_t/flong;
  990.   xac := (xac/2);
  991.   xat := (xat/2);
  992.   xag := (xag/2);
  993.   xct := (xct/2);
  994.   xcg := (xcg/2);
  995.   xgt := (xgt/2);
  996.   qa := xaa + xat + xac + xag;
  997.   qt := xat + xtt + xct + xgt;
  998.   qc := xac + xct + xcc + xcg;
  999.   qg := xag + xgt + xcg + xgg;
  1000.   p := qa + qt;
  1001.   q := qc + qg;
  1002.   b1 := (p*q)-(xac+xag+xct+xgt);
  1003.   f12 := xaa+xtt-xat-(sqr(p))+(3*qa*qt);
  1004.   f34 := xcc+xgg-xcg-(sqr(q))+(3*qc*qg);
  1005.   e12 := ((qa*q)-xac-xag)*((qt*q)-xct-xgt);
  1006.   e34 := ((qc*p)-xac-xct)*((qg*p)-xag-xgt);
  1007.   k1 := -(p*q)*ln(b1/(p*q));
  1008.   a := ((p/((3*qa)*qt))*(f12-b1+((3*e12)/b1)));
  1009.   b := ((q/((3*qc)*qg))*(f34-b1+((3*e34)/b1)));
  1010.   k2 := -((2*qa*qt)/p)*ln (a);
  1011.   k3 := -((2*qc*qg)/q)*ln (b);
  1012.   dKimura6 :=  k1 + k2 + k3;
  1013.   codeerror:= 0;
  1014.   end;
  1015.  
  1016.               (*COMPUTE TAJIMA AND NEI'S DISTANCE AND VARIANCE, 4 PARAMETERS*)
  1017. PROCEDURE TajNei (flong:integer; xaa, xac, xag, xat, xgg, xgt, xcg, xtt, xct, xcc, x_a, x_c, x_g, x_t : real;
  1018.                   var pdTajNei, pvTajNei: real);
  1019.   var b, c, sumagi, p, qa, qt, qc, qg: real;
  1020.   begin
  1021.   codeerror:= 25;
  1022.   p := (xac + xag + xat + xgt + xcg + xct)/flong;
  1023.   xaa := xaa/flong; xac := xac/flong; xag:= xag/flong; xat:= xat/flong;
  1024.   xgg := xgg/flong; xgt := xgt/flong; xcg:= xcg/flong; xtt:= xtt/flong;
  1025.   xct := xct/flong; xcc := xcc/flong; x_a:= x_a/flong; x_c:= x_c/flong;
  1026.   x_g := x_g/flong; x_t := x_t/flong;
  1027.   qa := xaa + (xat + xac + xag)/2;
  1028.   qt := xtt + (xat + xct + xgt)/2;
  1029.   qc := xcc + (xct + xac + xcg)/2;
  1030.   qg := xgg + (xgt + xcg + xag)/2;
  1031.   c := ((sqr(xac)/(2*qa*qc)) + (sqr(xat)/(2*qa*qt)) + (sqr(xag)/(2*qa*qg)) +
  1032.         (sqr(xct)/(2*qc*qt)) + (sqr(xcg)/(2*qc*qg)) + (sqr(xgt)/(2*qt*qg)));
  1033.   sumagi := sqr(qa) + sqr(qt) + sqr(qc) + sqr(qg);
  1034.   b := (1-sumagi+(sqr(p)/c))/2;
  1035.   pdTajNei := (-b)*ln (1-(p/b));
  1036.   pvTajNei := (sqr(b)*p*(1-p))/((sqr(b-p))*flong);
  1037.   codeerror:= 0;
  1038.   end; (*of procedure*)
  1039.  
  1040.                                           (*READING THE OPTIONS (FIRST) LINE*)
  1041. PROCEDURE ReadOptions;
  1042.   begin
  1043.   assign (readFile, readPath);
  1044.   codeerror:= 1;
  1045.   reset (readFile);
  1046.   codeerror:= 2;
  1047.   read (readFile, numSp, length);
  1048.   codeerror:= 8;
  1049.   close (readFile);
  1050.   codeerror:= 0;
  1051.   end; (*of procedure*)
  1052.  
  1053.                                                       (*CHECKING THE OPTIONS*)
  1054. PROCEDURE CheckOptions;
  1055.   begin
  1056.   if (numSp < NumMinSp) then
  1057.     begin
  1058.     textcolor (white);
  1059.     textbackground (black);
  1060.     clrscr;
  1061.     writeln ('Too few species. Must be >= ', NumMinSp:4, '.');
  1062.     cursoron;
  1063.     halt;
  1064.     end;
  1065.   if (numSp > NumMaxSp) then
  1066.     begin
  1067.     textcolor (white);
  1068.     textbackground (black);
  1069.     clrscr;
  1070.     writeln ('Too many species. Must be <= ', NumMaxSp:4, '.');
  1071.     cursoron;
  1072.     halt;
  1073.     end;
  1074.   end; (*of procedure*)
  1075.  
  1076.                                                  (*INITIALIZE SOME VARIABLES*)
  1077. PROCEDURE InitVars;
  1078.   var ind1, ind2 : integer;
  1079.   begin
  1080.   for ind1 := 1 to numSp do
  1081.   for ind2 := 1 to numSp do
  1082.     begin
  1083.     MAA [ind1, ind2] := 0; MGG [ind1, ind2] := 0; MTT [ind1, ind2] := 0;
  1084.     MCC [ind1, ind2] := 0; MAG [ind1, ind2] := 0; MCT [ind1, ind2] := 0;
  1085.     MAT [ind1, ind2] := 0; MCG [ind1, ind2] := 0; MAC [ind1, ind2] := 0;
  1086.     MGT [ind1, ind2] := 0; M_A [ind1, ind2] := 0; M_T [ind1, ind2] := 0;
  1087.     M_G [ind1, ind2] := 0; M_C [ind1, ind2] := 0; M__ [ind1, ind2] := 0;
  1088.     DistanceMatrix [ind1, ind2] := 0.0;
  1089.     lengthcom [ind1, ind2] := 0;
  1090.     end;
  1091.   end; (*of procedure*)
  1092.  
  1093.                             (*READING THE SEQUENCE FILE IN OLD PHYLIP FORMAT*)
  1094. PROCEDURE ReadingFileOldPhy (ppath : string);
  1095.   var l, charactercounter, charwithoutdel: integer;
  1096.       car : char;
  1097.       otrosetchar: set of char;
  1098.   begin
  1099.   textbackground (black);
  1100.   textcolor (white+blink);
  1101.   if mimodo=mmenu then
  1102.     begin
  1103.     gotoxy (26, 14);
  1104.     writeln ('READING THE INPUT FILE ...');
  1105.     end
  1106.   else
  1107.     begin
  1108.     writeln ('                    READING THE INPUT FILE ...');
  1109.     end;
  1110.   textcolor (white);
  1111.   otrosetchar:= ['A','a','C','c','T','t','G','g','U','u',' ','-'];
  1112.   lineaerror:= 1;
  1113.   assign (readfile, ppath);
  1114.   codeerror:= 1;
  1115.   reset (readfile);
  1116.   codeerror:= 6;
  1117.   readln (readfile);
  1118.   Inc (lineaerror,1);
  1119.   for l := 1 to NumMaxSp do
  1120.     begin
  1121.     lengthorig [l] := 0;
  1122.     end;
  1123.   codeerror:= 3;
  1124.   for l := 1 to numSp do
  1125.     begin
  1126.     charactercounter := 1;
  1127.     while charactercounter <= LengthNamSp do
  1128.       begin
  1129.       read (readfile, car);
  1130.       insert (car, vNamSp [l], charactercounter);
  1131.       inc (charactercounter);
  1132.       end;
  1133.     Inc (lineaerror);
  1134.     charactercounter := 0;
  1135.     charwithoutdel := 0;
  1136.     while (charactercounter < length) do
  1137.       begin
  1138.       read (readfile, car);
  1139.       if ((car <> ' ') and (car <> #13) and (car <> #10) and (car <> #26)) then
  1140.         begin
  1141.         if not (car in otrosetchar) then
  1142.           begin
  1143.           textcolor (white);
  1144.           textbackground (black);
  1145.           clrscr;
  1146.           writeln ('Wrong char. Must be A,a,C,c,T,t,G,g,U,u, ,-');
  1147.           writeln ('Error in line ', lineaerror:5);
  1148.           writeln ('Check your input format!');
  1149.           cursoron;
  1150.           halt;
  1151.           end;
  1152.         inc (charactercounter);
  1153.         if car <> '-' then Inc (charwithoutdel, 1);
  1154.         if mimodo=mmenu then
  1155.           begin
  1156.           GotoXY (19,16);
  1157.           Writeln (vnamsp [l], '  Char: ', car, '  Num Char: ', charactercounter:7);
  1158.           end;
  1159.         InsertEnd (setseq [l], car);
  1160.         end;
  1161.       end;
  1162.     if EOLN (readfile) then readln (readfile);
  1163.     if EOLN (readfile) then readln (readfile);
  1164.     lengthorig [l] := charwithoutdel;
  1165.     end; (*of for*)
  1166.   codeerror:= 8;
  1167.   close (readfile);
  1168.   codeerror:= 0;
  1169.   lineaerror:= 0;
  1170.   textbackground (black);
  1171.   textcolor (white+blink);
  1172.   if mimodo=mmenu then
  1173.     begin
  1174.     gotoxy (26, 14);
  1175.     writeln ('DOING THE CALCULATIONS ...');
  1176.     end
  1177.   else
  1178.     begin
  1179.     writeln ('                    DOING THE CALCULATIONS ...');
  1180.     end;
  1181.   textcolor (titlecolor);
  1182.   textbackground (windowforecolor);
  1183.   end;
  1184.  
  1185.                             (*READING THE SEQUENCE FILE IN NEW PHYLIP FORMAT*)
  1186. PROCEDURE ReadingFileNewPhy (ppath : string);
  1187.   var l, linecounter, charactercounter,
  1188.       charwithoutdel                    : integer;
  1189.       car                               : char;
  1190.       otrosetchar                       : set of char;
  1191.   begin
  1192.   textbackground (black);
  1193.   textcolor (white+blink);
  1194.   if mimodo=mmenu then
  1195.     begin
  1196.     gotoxy (26, 14);
  1197.     writeln ('READING THE INPUT FILE ...');
  1198.     end
  1199.   else
  1200.     begin
  1201.     writeln ('                    READING THE INPUT FILE ...');
  1202.     end;
  1203.   textcolor (white);
  1204.   otrosetchar:= ['A','a','C','c','T','t','G','g','U','u',' ','-'];
  1205.   lineaerror:= 1;
  1206.   assign (readfile, ppath);
  1207.   codeerror:= 1;
  1208.   reset (readfile);
  1209.   codeerror:= 6;
  1210.   readln (readfile);
  1211.   Inc (lineaerror);
  1212.   linecounter := 0;
  1213.   for l := 1 to NumMaxSp do
  1214.     begin
  1215.     lengthorig [l] := 0;
  1216.     end;
  1217.   codeerror:= 3;
  1218.   while not EOF (readfile) do
  1219.     begin
  1220.     for l := 1 to numSp do
  1221.       begin
  1222.       inc (Linecounter, 1);
  1223.       if linecounter <= numSp then
  1224.         begin
  1225.         charactercounter := 1;
  1226.         while charactercounter <= LengthNamSp do
  1227.           begin
  1228.           read (readfile, car);
  1229.           insert (car, vNamSp [linecounter], charactercounter);
  1230.           inc (charactercounter, 1);
  1231.           end;
  1232.         charactercounter := 0;
  1233.         charwithoutdel := 0;
  1234.         while not EOLN (readfile) do
  1235.           begin
  1236.           read (readfile, car);
  1237.           if car <> ' ' then
  1238.             begin
  1239.             if not (car in otrosetchar) then
  1240.               begin
  1241.               textcolor (white);
  1242.               textbackground (black);
  1243.               clrscr;
  1244.               writeln ('Wrong char. Must be A,a,C,c,T,t,G,g,U,u, ,-');
  1245.               writeln ('Error in line ', lineaerror:5);
  1246.               writeln('Check your input format!');
  1247.               cursoron;
  1248.               halt;
  1249.               end;
  1250.             inc (charactercounter, 1);
  1251.             if car <> '-' then Inc (charwithoutdel, 1);
  1252.             if mimodo=mmenu then
  1253.               begin
  1254.               GotoXY (15,16);
  1255.               Writeln (vnamsp [l], ' Char: ', car, '  Line: ', linecounter:5, '  Num Char: ', charactercounter:7);
  1256.               end;
  1257.             InsertEnd (setseq [l], car);
  1258.             end;
  1259.           end;
  1260.         lengthorig [l] := lengthorig [l] + charwithoutdel;
  1261.         readln (readfile);
  1262.         Inc (lineaerror);
  1263.         end
  1264.       else
  1265.         begin
  1266.         charactercounter := 0;
  1267.         charwithoutdel := 0;
  1268.         while not EOLN (readfile) do
  1269.           begin
  1270.           read (readfile, car);
  1271.           if car <> ' ' then
  1272.             begin
  1273.             if not (car in otrosetchar) then
  1274.               begin
  1275.               textcolor (white);
  1276.               textbackground (black);
  1277.               clrscr;
  1278.               writeln ('Wrong char. Must be A,a,C,c,T,t,G,g,U,u, ,-');
  1279.               writeln (' Error in line ', lineaerror:5);
  1280.               cursoron;
  1281.               halt;
  1282.               end;
  1283.             inc (charactercounter, 1);
  1284.             if car <> '-' then Inc (charwithoutdel, 1);
  1285.             if mimodo=mmenu then
  1286.               begin
  1287.               GotoXY (15,16);
  1288.               Writeln (vnamsp [l], ' Char: ', car, '  Line: ', linecounter:5, '  Num Char: ', charactercounter:7);
  1289.               end;
  1290.             InsertEnd (setseq [l], car);
  1291.             end;
  1292.           end;
  1293.         lengthorig [l] := lengthorig [l] + charwithoutdel;
  1294.         readln (readfile);
  1295.         Inc (lineaerror);
  1296.         end;
  1297.       end; (*of for*)
  1298.       readln (readFile);
  1299.       Inc (lineaerror);
  1300.     end; (*of while*)
  1301.   codeerror:= 8;
  1302.   close (readfile);
  1303.   codeerror:= 0;
  1304.   lineaerror:= 0;
  1305.   textbackground (black);
  1306.   textcolor (white+blink);
  1307.   if mimodo=mmenu then
  1308.     begin
  1309.     gotoxy (26, 14);
  1310.     writeln ('DOING THE CALCULATIONS ...');
  1311.     end
  1312.   else
  1313.     begin
  1314.     writeln ('                    DOING THE CALCULATIONS ...');
  1315.     end;
  1316.   textcolor (titlecolor);
  1317.   textbackground (windowforecolor);
  1318.   end; (*of procedure*)
  1319.  
  1320.                                    (*READING THE SEQUENCE FILE IN MSF FORMAT*)
  1321. PROCEDURE ReadingFileMSF (ppath : string);
  1322.   var car                    : char;
  1323.       bor                    : string[2];
  1324.       bloquecounter, plength,
  1325.         charactercounter, l,
  1326.         cte, i, spcounter,
  1327.         charwithoutdel       : integer;
  1328.       otrosetchar            : set of char;
  1329.   begin
  1330.   textbackground (black);
  1331.   textcolor (white+blink);
  1332.   if mimodo=mmenu then
  1333.     begin
  1334.     gotoxy (26, 14);
  1335.     writeln ('READING THE INPUT FILE ...');
  1336.     end
  1337.   else
  1338.     begin
  1339.     writeln ('                    READING THE INPUT FILE ...');
  1340.     end;
  1341.   textcolor (white);
  1342.   for l := 1 to NumMaxSp do
  1343.     begin
  1344.     lengthorig [l] := 0;
  1345.     end;
  1346.   otrosetchar:= ['A','a','C','c','T','t','G','g','U','u',' ','.'];
  1347.   codeerror:= 0;
  1348.   assign (readfile, ppath);
  1349.   lineaerror:= 1;
  1350.   codeerror:= 1;
  1351.   reset (readfile);
  1352.   codeerror:= 6;
  1353.   repeat
  1354.     readln (readFile, bor); Inc (lineaerror);
  1355.   until bor='//';
  1356.   readln (readFile); Inc (lineaerror);
  1357.   bloquecounter := 1;
  1358.   spcounter:= 1;
  1359.   numsp:= 0;
  1360.   readln (readFile); Inc (lineaerror);
  1361.   while not EOF (readFile) do
  1362.     begin
  1363.     Inc (lineaerror);
  1364.     if bloquecounter = 1 then
  1365.       begin
  1366.       plength:= 0;
  1367.       charactercounter := 1;
  1368.       while charactercounter <= LengthNamSp-1 do
  1369.         begin
  1370.         read (readfile, car);
  1371.         insert (car, vNamSp [spcounter], charactercounter);
  1372.         inc (charactercounter, 1);
  1373.         end;
  1374.       insert (' ', vNamSp [spcounter], LengthNamSp);
  1375.       charwithoutdel := 0;
  1376.       while not EOLN (readfile) do
  1377.         begin
  1378.         read (readfile, car);
  1379.         if car <> ' ' then
  1380.           begin
  1381.           if not (car in otrosetchar) then
  1382.             begin
  1383.             textcolor (white);
  1384.             textbackground (black);
  1385.             clrscr;
  1386.             writeln ('Wrong char. Must be A,a,C,c,T,t,G,g,U,u, ,.');
  1387.             writeln (' Error in line ', lineaerror:5);
  1388.             writeln('Check your input format!');
  1389.             cursoron;
  1390.             halt;
  1391.             end;
  1392.           inc (plength, 1);
  1393.           if car <> '.' then Inc (charwithoutdel, 1);
  1394.           if mimodo=mmenu then
  1395.             begin
  1396.             GotoXY (20,16);
  1397.             Writeln (vnamsp [spcounter], ' Char: ', car, '  Num Char: ', plength:7);
  1398.             end;
  1399.           InsertEnd (setseq [spcounter], car);
  1400.           end;
  1401.         end;
  1402.       lengthorig [spcounter]:= charwithoutdel;
  1403.       readln (readfile); Inc (lineaerror);
  1404.       Inc (spcounter);
  1405.       if EOLN (readFile) then begin
  1406.                               numSp := spcounter-1;
  1407.                               Inc (bloqueCounter);
  1408.                               spcounter:= 1;
  1409.                               readln (readFile); readln (readFile); Inc (lineaerror,2);
  1410.                               cte:= plength;
  1411.                               end;
  1412.       end
  1413.     else
  1414.       begin
  1415.       Inc (lineaerror);
  1416.       plength:= cte;
  1417.       for i:= 1 to LengthNamSp-1 do read (readFile, car);
  1418.       charwithoutdel := 0;
  1419.       while not EOLN (readfile) do
  1420.         begin
  1421.         read (readfile, car);
  1422.         if car <> ' ' then
  1423.           begin
  1424.           if not (car in otrosetchar) then
  1425.             begin
  1426.             textcolor (white);
  1427.             textbackground (black);
  1428.             clrscr;
  1429.             writeln ('Wrong char. Must be A,a,C,c,T,t,G,g,U,u, ,.');
  1430.             writeln (' Error in line ', lineaerror:5);
  1431.             writeln('Check your input format!');
  1432.             cursoron;
  1433.             halt;
  1434.             end;
  1435.           inc (plength, 1);
  1436.           if car <> '.' then Inc (charwithoutdel, 1);
  1437.           if mimodo=mmenu then
  1438.             begin
  1439.             GotoXY (20,16);
  1440.             Writeln (vnamsp [spcounter], ' Char: ', car, '  Num Char: ', plength:7);
  1441.             end;
  1442.           InsertEnd (setseq [spcounter], car);
  1443.           end;
  1444.         end;
  1445.       lengthorig [spcounter]:= lengthorig [spcounter] + charwithoutdel;
  1446.       readln (readfile); Inc (lineaerror);
  1447.       Inc (spcounter);
  1448.       if EOLN (readFile) then begin
  1449.                               Inc (lineaerror);
  1450.                               Inc (bloqueCounter);
  1451.                               spcounter:= 1;
  1452.                               readln (readFile); readln (readFile); Inc (lineaerror,2);
  1453.                               cte:= plength;
  1454.                               end;
  1455.       end; (*of else*)
  1456.     end; (*of while*)
  1457.   length:= plength;
  1458.   if (numSp < NumMinSp) then
  1459.     begin
  1460.     textcolor (white);
  1461.     textbackground (black);
  1462.     clrscr;
  1463.     writeln ('Too few species. Must be >= ', NumMinSp:4, '.');
  1464.     cursoron;
  1465.     halt;
  1466.     end;
  1467.   if (numSp > NumMaxSp) then
  1468.     begin
  1469.     textcolor (white);
  1470.     textbackground (black);
  1471.     clrscr;
  1472.     writeln ('Too many species. Must be <= ', NumMaxSp:4, '.');
  1473.     cursoron;
  1474.     halt;
  1475.     end;
  1476.   close (readfile);
  1477.   codeerror:= 0;
  1478.   lineaerror:= 0;
  1479.   textbackground (black);
  1480.   textcolor (white+blink);
  1481.   if mimodo=mmenu then
  1482.     begin
  1483.     gotoxy (26, 14);
  1484.     writeln ('DOING THE CALCULATIONS ...');
  1485.     end
  1486.   else
  1487.     begin
  1488.     writeln ('                    DOING THE CALCULATIONS ...');
  1489.     end;
  1490.   textcolor (titlecolor);
  1491.   textbackground (windowforecolor);
  1492.   end; (*of procedure*)
  1493.  
  1494.                                            (*MAKING THE BASES PAIRS MATRIX*)
  1495. PROCEDURE MakingMatrix;
  1496.   var ind1, ind2 : integer;
  1497.       a, b, d    : char;
  1498.       p, q       : tpointer;
  1499.       k, cont2   : integer;
  1500.   begin
  1501.   if ((format=1) or (format=2)) then d:='-' else d:='.';
  1502.   for ind1 := 1 to numSp do
  1503.   for ind2 := 1 to numSp do
  1504.     begin
  1505.     MAA [ind1, ind2]:= 0; MCC [ind1, ind2]:= 0; MTT [ind1, ind2]:= 0;
  1506.     MGG [ind1, ind2]:= 0; MAC [ind1, ind2]:= 0; MAT [ind1, ind2]:= 0;
  1507.     MAG [ind1, ind2]:= 0; MCG [ind1, ind2]:= 0; MCT [ind1, ind2]:= 0;
  1508.     MGT [ind1, ind2]:= 0; M_A [ind1, ind2]:= 0; M_C [ind1, ind2]:= 0;
  1509.     M_T [ind1, ind2]:= 0; M_G [ind1, ind2]:= 0; M__ [ind1, ind2]:= 0;
  1510.     end;
  1511.   for ind1 := 1 to numSp do
  1512.     begin
  1513.     for ind2 := ind1+1 to numSp do
  1514.       begin
  1515.       counterbas:= 0; cont2:= 0;
  1516.       p := setseq [ind1]; q := setseq [ind2];
  1517.       while (p <> nil) and (q <> nil) do
  1518.         begin
  1519.         if counterbas=0 then
  1520.           begin
  1521.           case baswhich of
  1522.            1 : begin end;
  1523.            2 : begin end;
  1524.            3 : begin end;
  1525.            4 : begin p:= p^.next; q:= q^.next; end;
  1526.            5 : begin end;
  1527.            6 : begin p:= p^.next; q:= q^.next; end;
  1528.            7 : begin
  1529.                p:= p^.next; q:= q^.next;
  1530.                p:= p^.next; q:= q^.next;
  1531.                end;
  1532.            end;
  1533.           end;
  1534.         a := p^.base; b := q^.base;
  1535.         Inc (counterbas); Inc (cont2);
  1536.         if ((a='A') and (b='A')) then Inc (MAA[ind1, ind2],1);
  1537.         if ((a='C') and (b='C')) then Inc (MCC[ind1, ind2],1);
  1538.         if ((a='G') and (b='G')) then Inc (MGG[ind1, ind2],1);
  1539.         if ((a='T') and (b='T')) then Inc (MTT[ind1, ind2],1);
  1540.         if ((a=d) and (b=d)) then Inc (M__[ind1, ind2],1);
  1541.         if ((a='A') and (b='C')) or ((a='C') and (b='A'))
  1542.                             then Inc (MAC[ind1, ind2],1);
  1543.         if ((a='A') and (b='G')) or ((a='G') and (b='A'))
  1544.                             then Inc (MAG[ind1, ind2],1);
  1545.         if ((a='A') and (b='T')) or ((a='T') and (b='A'))
  1546.                             then Inc (MAT[ind1, ind2],1);
  1547.         if ((a='C') and (b='G')) or ((a='G') and (b='C'))
  1548.                             then Inc (MCG[ind1, ind2],1);
  1549.         if ((a='C') and (b='T')) or ((a='T') and (b='C'))
  1550.                             then Inc (MCT[ind1, ind2],1);
  1551.         if ((a='G') and (b='T')) or ((a='T') and (b='G'))
  1552.                             then Inc (MGT[ind1, ind2],1);
  1553.         if ((a='A') and (b=d)) or ((a=d) and (b='A'))
  1554.                             then Inc (M_A[ind1, ind2],1);
  1555.         if ((a='C') and (b=d)) or ((a=d) and (b='C'))
  1556.                             then Inc (M_C[ind1, ind2],1);
  1557.         if ((a='G') and (b=d)) or ((a=d) and (b='G'))
  1558.                             then Inc (M_G[ind1, ind2],1);
  1559.         if ((a='T') and (b=d)) or ((a=d) and (b='T'))
  1560.                             then Inc (M_T[ind1, ind2],1);
  1561.         case baswhich of
  1562.           1 : begin p := p^.next; q := q^.next; end;
  1563.           2 : begin
  1564.               p := p^.next; q := q^.next;
  1565.               if ((((cont2-2) MOD 3)=0) and (p<>nil)) then begin Inc (cont2); p:= p^.next; q := q^.next; end;
  1566.               end;
  1567.           3 : begin
  1568.               p := p^.next; q := q^.next;
  1569.               if ((((cont2-1) MOD 3)=0) and (p<>nil)) then begin Inc (cont2); p:= p^.next; q := q^.next; end;
  1570.               end;
  1571.           4 : begin
  1572.               p := p^.next; q := q^.next;
  1573.               if ((((cont2+1) MOD 3)=0) and (p<>nil)) then begin Inc (cont2); p:= p^.next; q := q^.next; end;
  1574.               end;
  1575.           5 : begin
  1576.               k:= 1;
  1577.               while ((k<=3) and (p<>nil)) do
  1578.                 begin
  1579.                 p:= p^.next; q:= q^.next;
  1580.                 Inc (k);
  1581.                 end;
  1582.               end;
  1583.           6 : begin
  1584.               k:= 1;
  1585.               while ((k<=3) and (p<>nil)) do
  1586.                 begin
  1587.                 p:= p^.next; q:= q^.next;
  1588.                 Inc (k);
  1589.                 end;
  1590.               end;
  1591.           7 : begin
  1592.               k:= 1;
  1593.               while ((k<=3) and (p<>nil)) do
  1594.                 begin
  1595.                 p:= p^.next; q:= q^.next;
  1596.                 Inc (k);
  1597.                 end;
  1598.               end;
  1599.           end; (*of case*)
  1600.         end; (*of while*)
  1601.       end;
  1602.     end;
  1603.   end; (*of procedure*)
  1604.  
  1605.                                              (*READING THE CODON USAGE TABLE*)
  1606. PROCEDURE ReadingCodonTable (ptablewhich: integer);
  1607.   var ftable: text;
  1608.       i, j, k : integer;
  1609.       value: char;
  1610.   begin
  1611.   case ptablewhich of
  1612.     2: assign (ftable, 'standnuc.tab');
  1613.     3: assign (ftable, 'drosomit.tab');
  1614.     4: assign (ftable, 'yeastmit.tab');
  1615.     5: assign (ftable, 'mammit.tab');
  1616.     6: assign (ftable, 'ciliated.tab');
  1617.     end;
  1618.   reset (ftable);
  1619.   readln (ftable);
  1620.   for i:=1 to 21 do
  1621.     begin
  1622.     for j:=1 to 6 do
  1623.       begin
  1624.       read (ftable, value);
  1625.       end;
  1626.     for j:=1 to 8 do
  1627.       begin
  1628.       for k:=1 to 3 do
  1629.         begin
  1630.         read (ftable, value);
  1631.         codontable [i, j, k]:= value;
  1632.         end;
  1633.       if j=8 then readln (ftable, value) else read (ftable, value);
  1634.       end;
  1635.     end;
  1636.   close (ftable);
  1637.   end; (*of procedure*)
  1638.  
  1639.                         (*CALCULATE THE SYNONYMOUS AND NON SYNONYMOUS MATRIX*)
  1640. PROCEDURE MakSyn_NonSynMatrix;
  1641.   type tcodon= array [1..3] of char;
  1642.   var codon1, codon2,
  1643.         codon3, codon4   : tcodon;
  1644.       aa1, aa2, aa3, aa4 : integer;
  1645.       ind1, ind2, ind3   : integer;
  1646.       syn, nonsyn        : real;
  1647.       ssyn, snonsyn      : real;
  1648.       aversyn, avernonsyn,
  1649.         taversyn,
  1650.         tavernonsyn      : real;
  1651.       paths, diff,
  1652.         a, b             : integer;
  1653.       numaas             : integer;
  1654.       p, q, r            : tpointer;
  1655.       part               : boolean;
  1656.       d                  : char;
  1657.     function NumDiff (fcodon1, fcodon2: tcodon): integer;
  1658.       var i, x: integer;
  1659.       begin
  1660.       x:=0;
  1661.       for i:= 1 to 3 do
  1662.         begin
  1663.         if fcodon1[i]<>fcodon2[i] then inc (x);
  1664.         end;
  1665.       NumDiff:= x;
  1666.       end;
  1667.     function CodCodon (fcodon: tcodon): integer;
  1668.       var i, j, x: integer;
  1669.           h: boolean;
  1670.       begin
  1671.       h:= false;
  1672.       i:= 1; j:= 1;
  1673.       while (h=false) do
  1674.         begin
  1675.         if fcodon=codontable[i,j] then begin x:=i; h:=true; end;
  1676.         inc (j);
  1677.         if j=9 then begin j:=1; inc(i); end;
  1678.         end;
  1679.       CodCodon:= x;
  1680.       end;
  1681.     procedure FindDiff (fcodon1, fcodon2: tcodon; var pa, pb: integer);
  1682.       begin
  1683.       if fcodon1[1]<>fcodon2[1] then
  1684.         begin
  1685.         pa:=1;
  1686.         if fcodon1[2]<>fcodon2[2] then pb:=2 else pb:=3;
  1687.         end
  1688.       else begin pa:=2; pb:=3; end;
  1689.       end;
  1690.   begin
  1691.   if ((format=1) or (format=2)) then d:='-' else d:='.';
  1692.   for ind1 := 1 to NumSp do
  1693.     begin
  1694.     AverSitNonSyn [ind1]:= 0;
  1695.     AverSitSyn [ind1]:= 0;
  1696.     for ind2 := 1 to NumSp do
  1697.       begin
  1698.       SynMatrix [ind1, ind2]:= 0;
  1699.       NonSynMatrix [ind1, ind2]:= 0;
  1700.       end;
  1701.     end;
  1702.   for ind1:= 1 to NumSp do
  1703.     begin
  1704.     numaas:= 0;
  1705.     taversyn:= 0; tavernonsyn:= 0;
  1706.     r := setseq [ind1];
  1707.     while r <> nil do
  1708.       begin
  1709.       for ind3:=1 to 3 do codon1[ind3]:= '*';
  1710.       ind3:=1;
  1711.       while ((ind3<=3) and (r <> nil)) do
  1712.         begin
  1713.         codon1 [ind3] := r^.base;
  1714.         r:= r^.next;
  1715.         inc (ind3);
  1716.         end;
  1717.       part:=false;
  1718.       for ind3:=1 to 3 do
  1719.         begin
  1720.         if ((codon1[ind3]='*') or (codon1[ind3]=d)) then part:=true;
  1721.         end;
  1722.       if part=false then
  1723.         begin
  1724.         aversyn:= 0; avernonsyn:= 0;
  1725.         Inc (numaas);
  1726.         aa1:= CodCodon (codon1);
  1727.         codon2:= codon1;
  1728.         for ind3:= 1 to 3 do
  1729.           begin
  1730.           case codon1[ind3] of
  1731.            'A': begin
  1732.                 codon2[ind3]:='C';
  1733.                 aa2:= CodCodon (codon2);
  1734.                 if aa2=aa1 then aversyn:=aversyn+1 else avernonsyn:=avernonsyn+1;
  1735.                 codon2:= codon1;
  1736.                 codon2[ind3]:='T';
  1737.                 aa2:= CodCodon (codon2);
  1738.                 if aa2=aa1 then aversyn:=aversyn+1 else avernonsyn:=avernonsyn+1;
  1739.                 codon2:= codon1;
  1740.                 codon2[ind3]:='G';
  1741.                 aa2:= CodCodon (codon2);
  1742.                 if aa2=aa1 then aversyn:=aversyn+1 else avernonsyn:=avernonsyn+1;
  1743.                 codon2:= codon1;
  1744.                 end;
  1745.            'C': begin
  1746.                 codon2[ind3]:='A';
  1747.                 aa2:= CodCodon (codon2);
  1748.                 if aa2=aa1 then aversyn:=aversyn+1 else avernonsyn:=avernonsyn+1;
  1749.                 codon2:= codon1;
  1750.                 codon2[ind3]:='T';
  1751.                 aa2:= CodCodon (codon2);
  1752.                 if aa2=aa1 then aversyn:=aversyn+1 else avernonsyn:=avernonsyn+1;
  1753.                 codon2:= codon1;
  1754.                 codon2[ind3]:='G';
  1755.                 aa2:= CodCodon (codon2);
  1756.                 if aa2=aa1 then aversyn:=aversyn+1 else avernonsyn:=avernonsyn+1;
  1757.                 codon2:= codon1;
  1758.                 end;
  1759.            'G': begin
  1760.                 codon2[ind3]:='C';
  1761.                 aa2:= CodCodon (codon2);
  1762.                 if aa2=aa1 then aversyn:=aversyn+1 else avernonsyn:=avernonsyn+1;
  1763.                 codon2:= codon1;
  1764.                 codon2[ind3]:='T';
  1765.                 aa2:= CodCodon (codon2);
  1766.                 if aa2=aa1 then aversyn:=aversyn+1 else avernonsyn:=avernonsyn+1;
  1767.                 codon2:= codon1;
  1768.                 codon2[ind3]:='A';
  1769.                 aa2:= CodCodon (codon2);
  1770.                 if aa2=aa1 then aversyn:=aversyn+1 else avernonsyn:=avernonsyn+1;
  1771.                 codon2:= codon1;
  1772.                 end;
  1773.            'T': begin
  1774.                 codon2[ind3]:='C';
  1775.                 aa2:= CodCodon (codon2);
  1776.                 if aa2=aa1 then aversyn:=aversyn+1 else avernonsyn:=avernonsyn+1;
  1777.                 codon2:= codon1;
  1778.                 codon2[ind3]:='A';
  1779.                 aa2:= CodCodon (codon2);
  1780.                 if aa2=aa1 then aversyn:=aversyn+1 else avernonsyn:=avernonsyn+1;
  1781.                 codon2:= codon1;
  1782.                 codon2[ind3]:='G';
  1783.                 aa2:= CodCodon (codon2);
  1784.                 if aa2=aa1 then aversyn:=aversyn+1 else avernonsyn:=avernonsyn+1;
  1785.                 codon2:= codon1;
  1786.                 end;
  1787.            end; (*case*)
  1788.           end;(*for aa*)
  1789.           aversyn:= aversyn/3; avernonsyn:=avernonsyn/3;
  1790.           taversyn:= taversyn+aversyn; tavernonsyn:= tavernonsyn+avernonsyn;
  1791.         end; (*for part*)
  1792.       end; (*while seq*)
  1793.     AverSitSyn [ind1]:= taversyn; AverSitNonSyn [ind1]:= tavernonsyn;
  1794.     end; (*of specie*)
  1795.   for ind1 := 1 to NumSp do
  1796.     begin
  1797.     for ind2 := ind1+1 to numSp do
  1798.       begin
  1799.       ssyn:=0; snonsyn:=0;
  1800.       p := setseq [ind1]; q := setseq [ind2];
  1801.       while ((p <> nil) and (q <> nil)) do
  1802.         begin
  1803.         for ind3:=1 to 3 do begin codon1[ind3]:='*'; codon2[ind3]:='*'; end;
  1804.         ind3:=1;
  1805.         while ((ind3<=3) and ((p <> nil) and (q <> nil))) do
  1806.           begin
  1807.           codon1 [ind3] := p^.base; codon2 [ind3] := q^.base;
  1808.           p:= p^.next; q:= q^.next;
  1809.           inc (ind3);
  1810.           end;
  1811.         part:=false;
  1812.         for ind3:=1 to 3 do
  1813.           begin
  1814.           if ((codon1[ind3]='*') or (codon2[ind3]='*') or
  1815.               (codon1[ind3]=d) or (codon2[ind3]=d)) then part:=true;
  1816.           end;
  1817.         if part=false then
  1818.           begin
  1819.           aa1:= CodCodon (codon1); aa2:= CodCodon (codon2);
  1820.           diff:= NumDiff (codon1, codon2);
  1821.           syn:= 0; nonsyn:= 0;
  1822.           case diff of
  1823.             0: begin
  1824.                paths:=1;
  1825.                syn:=0; nonsyn:=0;
  1826.                end;
  1827.             1: begin
  1828.                paths:=1;
  1829.                if aa1=aa2 then syn:=syn+1 else nonsyn:=nonsyn+1;
  1830.                end;
  1831.             2: begin
  1832.                paths:=2;
  1833.                FindDiff (codon1, codon2, a, b);
  1834.                codon3:= codon1;
  1835.                codon3[a]:= codon2[a];
  1836.                aa3:= CodCodon (codon3);
  1837.                if aa3<>21 then
  1838.                  begin
  1839.                  if ((aa1=aa3) and (aa3=aa2)) then syn:= syn+2;
  1840.                  if ((aa1<>aa3) and (aa3=aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+1; end;
  1841.                  if ((aa1=aa3) and (aa3<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+1; end;
  1842.                  if ((aa1<>aa3) and (aa3<>aa2)) then nonsyn:= nonsyn+2;
  1843.                  end
  1844.                else Dec (paths);
  1845.                codon3:= codon1;
  1846.                codon3[b]:= codon2[b];
  1847.                aa3:= CodCodon (codon3);
  1848.                if aa3<>21 then
  1849.                  begin
  1850.                  if ((aa1=aa3) and (aa3=aa2)) then syn:= syn+2;
  1851.                  if ((aa1<>aa3) and (aa3=aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+1; end;
  1852.                  if ((aa1=aa3) and (aa3<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+1; end;
  1853.                  if ((aa1<>aa3) and (aa3<>aa2)) then nonsyn:= nonsyn+2;
  1854.                  end
  1855.                else Dec (paths);
  1856.                if paths>0 then
  1857.                  begin
  1858.                  syn:= syn/paths;
  1859.                  nonsyn:= nonsyn/paths;
  1860.                  end
  1861.                else begin syn:=0; nonsyn:=0; end;
  1862.                end;
  1863.             3: begin
  1864.                paths:=6;
  1865.                codon3:= codon1; codon4:= codon2;
  1866.                codon3[1]:= codon2[1]; codon4[2]:= codon1[2];
  1867.                aa3:= CodCodon (codon3); aa4:= CodCodon (codon4);
  1868.                if ((aa3<>21) and (aa4<>21)) then
  1869.                  begin
  1870.                  if ((aa1=aa3) and (aa3=aa4) and (aa4=aa2)) then syn:= syn+3;
  1871.                  if ((aa1=aa3) and (aa3=aa4) and (aa4<>aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
  1872.                  if ((aa1=aa3) and (aa3<>aa4) and (aa4=aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
  1873.                  if ((aa1<>aa3) and (aa3=aa4) and (aa4=aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
  1874.                  if ((aa1=aa3) and (aa3<>aa4) and (aa4<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
  1875.                  if ((aa1<>aa3) and (aa3=aa4) and (aa4<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
  1876.                  if ((aa1<>aa3) and (aa3<>aa4) and (aa4=aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
  1877.                  if ((aa1<>aa3) and (aa3<>aa4) and (aa4<>aa2)) then nonsyn := nonsyn+3;
  1878.                  end
  1879.                else Dec (paths);
  1880.  
  1881.                codon3:= codon1; codon4:= codon2;
  1882.                codon3[1]:= codon2[1]; codon4[3]:= codon1[3];
  1883.                aa3:= CodCodon (codon3); aa4:= CodCodon (codon4);
  1884.                if ((aa3<>21) and (aa4<>21)) then
  1885.                  begin
  1886.                  if ((aa1=aa3) and (aa3=aa4) and (aa4=aa2)) then syn:= syn+3;
  1887.                  if ((aa1=aa3) and (aa3=aa4) and (aa4<>aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
  1888.                  if ((aa1=aa3) and (aa3<>aa4) and (aa4=aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
  1889.                  if ((aa1<>aa3) and (aa3=aa4) and (aa4=aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
  1890.                  if ((aa1=aa3) and (aa3<>aa4) and (aa4<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
  1891.                  if ((aa1<>aa3) and (aa3=aa4) and (aa4<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
  1892.                  if ((aa1<>aa3) and (aa3<>aa4) and (aa4=aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
  1893.                  if ((aa1<>aa3) and (aa3<>aa4) and (aa4<>aa2)) then nonsyn := nonsyn+3;
  1894.                  end
  1895.                else Dec (paths);
  1896.  
  1897.                codon3:= codon1; codon4:= codon2;
  1898.                codon3[2]:= codon2[2]; codon4[1]:= codon1[1];
  1899.                aa3:= CodCodon (codon3); aa4:= CodCodon (codon4);
  1900.                if ((aa3<>21) and (aa4<>21)) then
  1901.                  begin
  1902.                  if ((aa1=aa3) and (aa3=aa4) and (aa4=aa2)) then syn:= syn+3;
  1903.                  if ((aa1=aa3) and (aa3=aa4) and (aa4<>aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
  1904.                  if ((aa1=aa3) and (aa3<>aa4) and (aa4=aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
  1905.                  if ((aa1<>aa3) and (aa3=aa4) and (aa4=aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
  1906.                  if ((aa1=aa3) and (aa3<>aa4) and (aa4<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
  1907.                  if ((aa1<>aa3) and (aa3=aa4) and (aa4<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
  1908.                  if ((aa1<>aa3) and (aa3<>aa4) and (aa4=aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
  1909.                  if ((aa1<>aa3) and (aa3<>aa4) and (aa4<>aa2)) then nonsyn := nonsyn+3;
  1910.                  end
  1911.                else Dec (paths);
  1912.  
  1913.                codon3:= codon1; codon4:= codon2;
  1914.                codon3[2]:= codon2[2]; codon4[3]:= codon1[3];
  1915.                aa3:= CodCodon (codon3); aa4:= CodCodon (codon4);
  1916.                if ((aa3<>21) and (aa4<>21)) then
  1917.                  begin
  1918.                  if ((aa1=aa3) and (aa3=aa4) and (aa4=aa2)) then syn:= syn+3;
  1919.                  if ((aa1=aa3) and (aa3=aa4) and (aa4<>aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
  1920.                  if ((aa1=aa3) and (aa3<>aa4) and (aa4=aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
  1921.                  if ((aa1<>aa3) and (aa3=aa4) and (aa4=aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
  1922.                  if ((aa1=aa3) and (aa3<>aa4) and (aa4<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
  1923.                  if ((aa1<>aa3) and (aa3=aa4) and (aa4<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
  1924.                  if ((aa1<>aa3) and (aa3<>aa4) and (aa4=aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
  1925.                  if ((aa1<>aa3) and (aa3<>aa4) and (aa4<>aa2)) then nonsyn := nonsyn+3;
  1926.                  end
  1927.                else Dec (paths);
  1928.  
  1929.                codon3:= codon1; codon4:= codon2;
  1930.                codon3[3]:= codon2[3]; codon4[1]:= codon1[1];
  1931.                aa3:= CodCodon (codon3); aa4:= CodCodon (codon4);
  1932.                if ((aa3<>21) and (aa4<>21)) then
  1933.                  begin
  1934.                  if ((aa1=aa3) and (aa3=aa4) and (aa4=aa2)) then syn:= syn+3;
  1935.                  if ((aa1=aa3) and (aa3=aa4) and (aa4<>aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
  1936.                  if ((aa1=aa3) and (aa3<>aa4) and (aa4=aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
  1937.                  if ((aa1<>aa3) and (aa3=aa4) and (aa4=aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
  1938.                  if ((aa1=aa3) and (aa3<>aa4) and (aa4<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
  1939.                  if ((aa1<>aa3) and (aa3=aa4) and (aa4<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
  1940.                  if ((aa1<>aa3) and (aa3<>aa4) and (aa4=aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
  1941.                  if ((aa1<>aa3) and (aa3<>aa4) and (aa4<>aa2)) then nonsyn := nonsyn+3;
  1942.                  end
  1943.                else Dec (paths);
  1944.  
  1945.                codon3:= codon1; codon4:= codon2;
  1946.                codon3[3]:= codon2[3]; codon4[2]:= codon1[2];
  1947.                aa3:= CodCodon (codon3); aa4:= CodCodon (codon4);
  1948.                if ((aa3<>21) and (aa4<>21)) then
  1949.                  begin
  1950.                  if ((aa1=aa3) and (aa3=aa4) and (aa4=aa2)) then syn:= syn+3;
  1951.                  if ((aa1=aa3) and (aa3=aa4) and (aa4<>aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
  1952.                  if ((aa1=aa3) and (aa3<>aa4) and (aa4=aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
  1953.                  if ((aa1<>aa3) and (aa3=aa4) and (aa4=aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
  1954.                  if ((aa1=aa3) and (aa3<>aa4) and (aa4<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
  1955.                  if ((aa1<>aa3) and (aa3=aa4) and (aa4<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
  1956.                  if ((aa1<>aa3) and (aa3<>aa4) and (aa4=aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
  1957.                  if ((aa1<>aa3) and (aa3<>aa4) and (aa4<>aa2)) then nonsyn := nonsyn+3;
  1958.                  end
  1959.                else Dec (paths);
  1960.  
  1961.                if paths>0 then
  1962.                  begin
  1963.                  syn:= syn/paths;
  1964.                  nonsyn:= nonsyn/paths;
  1965.                  end
  1966.                else begin syn:=0; nonsyn:=0; end;
  1967.                end;
  1968.             end; (*of case*)
  1969.           ssyn:= ssyn+syn; snonsyn:= snonsyn+nonsyn;
  1970.           end; (*if*)
  1971.         end; (*while*)
  1972.       SynMatrix[ind1, ind2]:= ssyn; NonSynMatrix[ind1, ind2]:= snonsyn;
  1973.       end; (*for*)
  1974.     end; (*for*)
  1975.   end; (*of procedure*)
  1976.  
  1977.                                        (*CALCULATE THE COMUN DISTANCE MATRIX*)
  1978. PROCEDURE MakLenghtComMatrix;
  1979.   var i, j : integer;
  1980.   begin
  1981.   for i := 1 to numSp do
  1982.   for j := 1 to numSp do
  1983.     begin
  1984.     lengthcom [i, j] := MAA [i,j]+MCC [i,j]+MGG [i,j]+MTT [i,j]+MAC [i,j]+
  1985.                         MAG [i,j]+MAT [i,j]+MCG [i,j]+MCT [i,j]+MGT [i,j];
  1986.     end;
  1987.   end; (*of procedure*)
  1988.  
  1989.                                              (*CALCULATE THE DISTANCE MATRIX*)
  1990. PROCEDURE MakDistanceMatrix;
  1991.   var i, j : integer;
  1992.   begin
  1993.   for i := 1 to numSp do
  1994.   for j := i+1 to numSp do
  1995.     begin
  1996.     case dist of
  1997.       1 : begin  (*JUKES-CANTOR*)
  1998.           DistanceMatrix [i, j] :=
  1999.             dJukesCantor (lengthcom[i,j],MAC[i,j],MAG [i,j],MAT[i,j],MGT[i,j],MCG[i,j],
  2000.                            MCT [i,j], M_A [i,j], M_C [i,j], M_G[i,j], M_T[i,j]);
  2001.           VarianceMatrix [i, j] :=
  2002.             vJukesCantor (lengthcom[i,j],MAC[i,j],MAG [i,j],MAT[i,j],MGT[i,j],MCG[i,j],
  2003.                            MCT [i,j], M_A [i,j], M_C [i,j], M_G[i,j], M_T[i,j]);
  2004.           end;
  2005.       2 : begin  (*KIMURA2*)
  2006.           DistanceMatrix [i, j] :=
  2007.             dKimura2 (lengthcom[i,j],MAC[i,j],MAG [i,j],MAT[i,j],MGt[i,j],MCG[i,j],
  2008.                       MCt [i,j], M_A [i,j], M_C [i,j], M_G[i,j], M_T[i,j]);
  2009.           VarianceMatrix [i, j] :=
  2010.             vKimura2 (lengthcom[i,j],MAC[i,j],MAG [i,j],MAT[i,j],MGT[i,j],MCG[i,j],
  2011.                       MCT [i,j], M_A [i,j], M_C [i,j], M_G[i,j], M_T[i,j]);
  2012.           end;
  2013.       3 : begin  (*KIMURA3*)
  2014.           DistanceMatrix [i, j] :=
  2015.             dKimura3 (lengthcom[i,j],MAC[i,j],MAG [i,j],MAT[i,j],MGt[i,j],MCG[i,j],
  2016.                       MCt [i,j], M_A [i,j], M_C [i,j], M_G[i,j], M_T[i,j]);
  2017.           VarianceMatrix [i, j] :=
  2018.             vKimura3 (lengthcom[i,j],MAC[i,j],MAG [i,j],MAT[i,j],MGT[i,j],MCG[i,j],
  2019.                       MCT [i,j], M_A [i,j], M_C [i,j], M_G[i,j], M_T[i,j]);
  2020.           end;
  2021.       4 : begin  (*KIMURA4*)
  2022.           DistanceMatrix [i, j] :=
  2023.             dKimura4 (lengthcom[i,j],MAA[i,j],MAC[i,j],MAG [i,j],MAT[i,j],MGG[i,j],MGT[i,j],MCG[i,j],
  2024.                       MTT[i,j],MCT [i,j], MCC [i,j], M_A [i,j], M_C [i,j], M_G[i,j], M_T[i,j]);
  2025.           end;
  2026.       5 : begin  (*KIMURA6*)
  2027.           DistanceMatrix [i, j] :=
  2028.             dKimura6 (lengthcom[i,j],MAA[i,j],MAC[i,j],MAG [i,j],MAT[i,j],MGG[i,j],MGT[i,j],MCG[i,j],
  2029.                       MTT[i,j],MCT [i,j], MCC [i,j], M_A [i,j], M_C [i,j], M_G[i,j], M_T[i,j]);
  2030.           end;
  2031.       6 : begin  (*TAJIMA AND NEI*)
  2032.           TajNei (lengthcom[i,j],MAA[i,j],MAC[i,j],MAG [i,j],MAT[i,j],MGG[i,j],MGT[i,j],MCG[i,j],
  2033.                   MTT[i,j],MCT [i,j], MCC [i,j], M_A [i,j], M_C [i,j], M_G[i,j], M_T[i,j],
  2034.                   dTajNei, vTajNei);
  2035.           DistanceMatrix [i, j] := dTajNei;
  2036.           VarianceMatrix [i, j] := vTajNei;
  2037.           end;
  2038.       end; (*of case*)
  2039.     end; (*of for*)
  2040.   end; (*of procedure*)
  2041.  
  2042.                                                            (*WRITING RESULTS*)
  2043. PROCEDURE WritingResults;
  2044.   var ind1, ind2    : integer;
  2045.       tira1, tira2,
  2046.       tira3, tira4,
  2047.       tira5         : string[40];
  2048.       real1, real2  : real;
  2049.   begin
  2050.   codeerror:= 14;
  2051.   case dist of
  2052.    1 : tira1 := 'JUKES-CANTOR ';
  2053.    2 : tira1 := 'KIMURA 2 PARAMETERS ';
  2054.    3 : tira1 := 'KIMURA 3 PARAMETERS ';
  2055.    4 : tira1 := 'KIMURA 4 PARAMETERS ';
  2056.    5 : tira1 := 'KIMURA 6 PARAMETERS ';
  2057.    6 : tira1 := 'TAJIMA-NEI ';
  2058.    end;
  2059.   case TypeOutput of
  2060.    1 : tira2 := 'LARGE OUTPUT FILE';
  2061.    2 : tira2 := 'BRIEF OUTPUT FILE';
  2062.    3 : tira2 := 'OUTPUT FOR FITCH AND KITSCH';
  2063.    end;
  2064.   case Format of
  2065.    1 : tira3 := 'INTERLEAVED (PHYLIP VERSION 3.3.)';
  2066.    2 : tira3 := 'ALIGNED (PHYLIP OLDER VERSIONS)';
  2067.    3 : tira3 := 'MSF FORMAT (GCG''s PILEUP PROGRAM RESULT)';
  2068.    end;
  2069.   case baswhich of
  2070.    1 : tira4 := 'ALL THE BASES';
  2071.    2 : tira4 := '1st AND 2nd BASES';
  2072.    3 : tira4 := '1st AND 3rd BASES';
  2073.    4 : tira4 := '2st AND 3rd BASES';
  2074.    5 : tira4 := '1st BASE';
  2075.    6 : tira4 := '2nd BASE';
  2076.    7 : tira4 := '3rd BASE';
  2077.    end;
  2078.   case tablewhich of
  2079.    1 : tira5 := '';
  2080.    2 : tira5 := 'STANDARD CODE.';
  2081.    3 : tira5 := 'DROSOPHILA MITOCHONDRIAL.';
  2082.    4 : tira5 := 'YEAST MITOCHONDRIAL.';
  2083.    5 : tira5 := 'MAMMALIAN MITOCHONDRIAL.';
  2084.    6 : tira5 := 'CILIATED.';
  2085.    end;
  2086.  
  2087.   if ((TypeOutput = 1) or (TypeOutput = 2)) then
  2088.     begin
  2089.     writeln (writeFile);
  2090.     writeln (writeFile, '         DISTANCE 3.0. 1993  J.A. López Bueno');
  2091.     writeln (writeFile);
  2092.     writeln (writeFile, 'The DNA sequence file is:       ', readPath);
  2093.     writeln (writeFile, 'The results file is:            ', writePath);
  2094.     writeln (writeFile, 'The number of species is:          ', numSp);
  2095.     writeln (writeFile, 'The aligned sequences length is: ', length);
  2096.     writeln (writeFile, 'The program options are: ');
  2097.     writeln (writeFile, '   Distance method:             ', tira1);
  2098.     writeln (writeFile, '   Output:                      ', tira2);
  2099.     writeln (writeFile, '   Format:                      ', tira3);
  2100.     writeln (writeFile, '   Using counter base option:   ', tira4);
  2101.     writeln (writeFile, 'The number of bases being');
  2102.     writeln (writeFile, '     considered is:             ', counterbas);
  2103.     writeln (writeFile);
  2104.     end;
  2105.  
  2106.   if TypeOutput = 1 then
  2107.     begin
  2108.     writeln (writeFile, 'The vector length -without deletions- is: ');
  2109.     for ind1 :=1 to numSp do
  2110.       begin
  2111.       writeln (writeFile, vNamSp[ind1], lengthorig [ind1]:10);
  2112.      end;
  2113.     writeln (writeFile);
  2114.  
  2115.     writeln (writeFile, 'The common length matrix is: ');
  2116.     writeln (writeFile);
  2117.     for ind1 :=2 to numSp do
  2118.       begin
  2119.       write (writefile, vNamSp[ind1]);
  2120.       for ind2 :=1 to ind1-1 do
  2121.         begin
  2122.         write (writeFile, lengthcom[ind2,ind1]:10);
  2123.         end;
  2124.       writeln (writefile);
  2125.       end;
  2126.     write (writeFile, '               ');
  2127.     for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2128.     writeln (writeFile);
  2129.     writeln (writeFile);
  2130.  
  2131.     writeln (writeFile, 'The Hamming distance matrix is: ');
  2132.     writeln (writeFile);
  2133.     for ind1 :=2 to numSp do
  2134.       begin
  2135.       write (writeFile, vNamSp[ind1]);
  2136.       for ind2 :=1 to ind1-1 do
  2137.         begin
  2138.         hamm := MAC[ind2,ind1]+MAG[ind2,ind1]+MAT[ind2,ind1]+
  2139.                 MCG[ind2,ind1]+MCT[ind2,ind1]+MGT[ind2,ind1];
  2140.         write (writeFile, hamm:10);
  2141.         end;
  2142.       writeln (writeFile);
  2143.       end;
  2144.     write (writeFile, '               ');
  2145.     for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2146.     writeln (writeFile);
  2147.     writeln (writeFile);
  2148.  
  2149.     writeln (writeFile, 'The transitions matrix is: ');
  2150.     writeln (writeFile);
  2151.     for ind1 :=2 to numSp do
  2152.       begin
  2153.       write (writefile, vNamSp[ind1]);
  2154.       for ind2 :=1 to ind1-1 do
  2155.         begin
  2156.         transi := MAG[ind2,ind1]+MCT[ind2,ind1];
  2157.         write (writeFile, transi:10);
  2158.         end;
  2159.       writeln (writefile);
  2160.       end;
  2161.     write (writeFile, '               ');
  2162.     for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2163.     writeln (writeFile);
  2164.     writeln (writeFile);
  2165.  
  2166.     writeln (writeFile, 'The transversions matrix is: ');
  2167.     writeln (writeFile);
  2168.     for ind1 :=2 to numSp do
  2169.       begin
  2170.       write (writefile, vNamSp[ind1]);
  2171.       for ind2 :=1 to ind1-1 do
  2172.         begin
  2173.         transver := MAC[ind2,ind1]+MAT[ind2,ind1]+MCG[ind2,ind1]+MGT[ind2,ind1];
  2174.         write (writeFile, transver:10);
  2175.         end;
  2176.       writeln (writefile);
  2177.       end;
  2178.     write (writeFile, '               ');
  2179.     for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2180.     writeln (writeFile);
  2181.     writeln (writeFile);
  2182.  
  2183.     if ((baswhich=1) and (tablewhich<>1)) then
  2184.       begin
  2185.       writeln (writeFile, 'Translation code table used: ', tira5);
  2186.       writeln (writeFile);
  2187.       writeln (writeFile, '   The proportion of synonymous differences matrix is: ');
  2188.       writeln (writeFile, '    (unweighted pathway method, Nei and Gojobori)');
  2189.       writeln (writeFile);
  2190.       for ind1 :=2 to numSp do
  2191.         begin
  2192.         write (writefile, vNamSp[ind1]);
  2193.         for ind2 :=1 to ind1-1 do
  2194.           begin
  2195.           write (writeFile,
  2196.            ((SynMatrix[ind2, ind1]/((AverSitSyn[ind1]+AverSitSyn[ind2])/2))):10:4);
  2197.           end;
  2198.         writeln (writefile);
  2199.         end;
  2200.       write (writeFile, '               ');
  2201.       for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2202.       writeln (writeFile);
  2203.       writeln (writeFile);
  2204.  
  2205.       writeln (writeFile, '   The proportion of non synonymous differences matrix is: ');
  2206.       writeln (writeFile, '    (unweighted pathway method, Nei and Gojobori)');
  2207.       writeln (writeFile);
  2208.       for ind1 :=2 to numSp do
  2209.         begin
  2210.         write (writefile, vNamSp[ind1]);
  2211.         for ind2 :=1 to ind1-1 do
  2212.           begin
  2213.           write (writeFile,
  2214.            ((NonSynMatrix[ind2, ind1]/((AverSitNonSyn[ind1]+AverSitNonSyn[ind2])/2))):10:4);
  2215.           end;
  2216.         writeln (writefile);
  2217.         end;
  2218.       write (writeFile, '               ');
  2219.       for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2220.       writeln (writeFile);
  2221.       writeln (writeFile);
  2222.  
  2223.       writeln (writeFile, '   Matrix of synonymous substitutions per site is: ');
  2224.       writeln (writeFile, '    (unweighted pathway method, Nei and Gojobori)');
  2225.       writeln (writeFile);
  2226.       for ind1 :=2 to numSp do
  2227.         begin
  2228.         write (writefile, vNamSp[ind1]);
  2229.         for ind2 :=1 to ind1-1 do
  2230.           begin
  2231.           real1:= (SynMatrix[ind2, ind1]/((AverSitSyn[ind1]+AverSitSyn[ind2])/2));
  2232.           real2:= FormJC (real1);
  2233.           write (writeFile, real2:10:4);
  2234.           end;
  2235.         writeln (writefile);
  2236.         end;
  2237.       write (writeFile, '               ');
  2238.       for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2239.       writeln (writeFile);
  2240.       writeln (writeFile);
  2241.  
  2242.       writeln (writeFile, '   Matrix of nonsynonymous substitutions per site is: ');
  2243.       writeln (writeFile, '    (unweighted pathway method, Nei and Gojobori)');
  2244.       writeln (writeFile);
  2245.       for ind1 :=2 to numSp do
  2246.         begin
  2247.         write (writefile, vNamSp[ind1]);
  2248.         for ind2 :=1 to ind1-1 do
  2249.           begin
  2250.           real1:= (NonSynMatrix[ind2, ind1]/((AverSitNonSyn[ind1]+AverSitNonSyn[ind2])/2));
  2251.           real2:= FormJC (real1);
  2252.           write (writeFile, real2:10:4);
  2253.           end;
  2254.         writeln (writefile);
  2255.         end;
  2256.       write (writeFile, '               ');
  2257.       for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2258.       writeln (writeFile);
  2259.       writeln (writeFile);
  2260.       end;
  2261.  
  2262.     writeln (writeFile);
  2263.     writeln (writeFile, 'The A-to-A matrix is: ');
  2264.     writeln (writeFile);
  2265.     for ind1 :=2 to numSp do
  2266.       begin
  2267.       write (writefile, vNamSp[ind1]);
  2268.       for ind2 :=1 to ind1-1 do
  2269.         begin
  2270.         write (writeFile, MAA[ind2, ind1]:10);
  2271.         end;
  2272.       writeln (writefile);
  2273.       end;
  2274.     write (writeFile, '               ');
  2275.     for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2276.     writeln (writeFile);
  2277.     writeln (writeFile);
  2278.  
  2279.     writeln (writeFile, 'The C-to-C matrix is: ');
  2280.     writeln (writeFile);
  2281.     for ind1 :=2 to numSp do
  2282.       begin
  2283.       write (writefile, vNamSp[ind1]);
  2284.       for ind2 :=1 to ind1-1 do
  2285.         begin
  2286.         write (writeFile, MCC[ind2, ind1]:10);
  2287.         end;
  2288.       writeln (writefile);
  2289.       end;
  2290.     write (writeFile, '               ');
  2291.     for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2292.     writeln (writeFile);
  2293.     writeln (writeFile);
  2294.  
  2295.     writeln (writeFile, 'The G-to-G matrix is: ');
  2296.     writeln (writeFile);
  2297.     for ind1 :=2 to numSp do
  2298.       begin
  2299.       write (writefile, vNamSp[ind1]);
  2300.       for ind2 :=1 to ind1-1 do
  2301.         begin
  2302.         write (writeFile, MGG[ind2, ind1]:10);
  2303.         end;
  2304.       writeln (writefile);
  2305.       end;
  2306.     write (writeFile, '               ');
  2307.     for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2308.     writeln (writeFile);
  2309.     writeln (writeFile);
  2310.  
  2311.     writeln (writeFile, 'The T-to-T matrix is: ');
  2312.     writeln (writeFile);
  2313.     for ind1 :=2 to numSp do
  2314.       begin
  2315.       write (writefile, vNamSp[ind1]);
  2316.       for ind2 :=1 to ind1-1 do
  2317.         begin
  2318.         write (writeFile, MTT[ind2, ind1]:10);
  2319.         end;
  2320.       writeln (writefile);
  2321.       end;
  2322.     write (writeFile, '               ');
  2323.     for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2324.     writeln (writeFile);
  2325.     writeln (writeFile);
  2326.  
  2327.     writeln (writeFile, 'The A-to-C matrix is: ');
  2328.     writeln (writeFile);
  2329.     for ind1 :=2 to numSp do
  2330.       begin
  2331.       write (writefile, vNamSp[ind1]);
  2332.       for ind2 :=1 to ind1-1 do
  2333.         begin
  2334.         write (writeFile, MAC[ind2, ind1]:10);
  2335.         end;
  2336.       writeln (writefile);
  2337.       end;
  2338.     write (writeFile, '               ');
  2339.     for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2340.     writeln (writeFile);
  2341.     writeln (writeFile);
  2342.  
  2343.     writeln (writeFile, 'The A-to-G matrix is: ');
  2344.     writeln (writeFile);
  2345.     for ind1 :=2 to numSp do
  2346.       begin
  2347.       write (writefile, vNamSp[ind1]);
  2348.       for ind2 :=1 to ind1-1 do
  2349.         begin
  2350.         write (writeFile, MAG[ind2, ind1]:10);
  2351.         end;
  2352.       writeln (writefile);
  2353.       end;
  2354.     write (writeFile, '               ');
  2355.     for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2356.     writeln (writeFile);
  2357.     writeln (writeFile);
  2358.  
  2359.     writeln (writeFile, 'The A-to-T matrix is: ');
  2360.     writeln (writeFile);
  2361.     for ind1 :=2 to numSp do
  2362.       begin
  2363.       write (writefile, vNamSp[ind1]);
  2364.       for ind2 :=1 to ind1-1 do
  2365.         begin
  2366.         write (writeFile, MAT[ind2, ind1]:10);
  2367.         end;
  2368.       writeln (writefile);
  2369.       end;
  2370.     write (writeFile, '               ');
  2371.     for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2372.     writeln (writeFile);
  2373.     writeln (writeFile);
  2374.  
  2375.     writeln (writeFile, 'The C-to-G matrix is: ');
  2376.     writeln (writeFile);
  2377.     for ind1 :=2 to numSp do
  2378.       begin
  2379.       write (writefile, vNamSp[ind1]);
  2380.       for ind2 :=1 to ind1-1 do
  2381.         begin
  2382.         write (writeFile, MCG[ind2, ind1]:10);
  2383.         end;
  2384.       writeln (writefile);
  2385.       end;
  2386.     write (writeFile, '               ');
  2387.     for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2388.     writeln (writeFile);
  2389.     writeln (writeFile);
  2390.  
  2391.     writeln (writeFile, 'The C-to-T matrix is: ');
  2392.     writeln (writeFile);
  2393.     for ind1 :=2 to numSp do
  2394.       begin
  2395.       write (writefile, vNamSp[ind1]);
  2396.       for ind2 :=1 to ind1-1 do
  2397.         begin
  2398.         write (writeFile, MCT[ind2, ind1]:10);
  2399.         end;
  2400.       writeln (writefile);
  2401.       end;
  2402.     write (writeFile, '               ');
  2403.     for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2404.     writeln (writeFile);
  2405.     writeln (writeFile);
  2406.  
  2407.     writeln (writeFile, 'The G-to-T matrix is: ');
  2408.     writeln (writeFile);
  2409.     for ind1 :=2 to numSp do
  2410.       begin
  2411.       write (writefile, vNamSp[ind1]);
  2412.       for ind2 :=1 to ind1-1 do
  2413.         begin
  2414.         write (writeFile, MGT[ind2, ind1]:10);
  2415.         end;
  2416.       writeln (writefile);
  2417.       end;
  2418.     write (writeFile, '               ');
  2419.     for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2420.     writeln (writeFile);
  2421.     writeln (writeFile);
  2422.  
  2423.     writeln (writeFile, 'The ''-''-to-A matrix is: ');
  2424.     writeln (writeFile);
  2425.     for ind1 :=2 to numSp do
  2426.       begin
  2427.       write (writefile, vNamSp[ind1]);
  2428.       for ind2 :=1 to ind1-1 do
  2429.         begin
  2430.         write (writeFile, M_A[ind2, ind1]:10);
  2431.         end;
  2432.       writeln (writefile);
  2433.       end;
  2434.     write (writeFile, '               ');
  2435.     for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2436.     writeln (writeFile);
  2437.     writeln (writeFile);
  2438.  
  2439.     writeln (writeFile, 'The ''-''-to-C matrix is: ');
  2440.     writeln (writeFile);
  2441.     for ind1 :=2 to numSp do
  2442.       begin
  2443.       write (writefile, vNamSp[ind1]);
  2444.       for ind2 :=1 to ind1-1 do
  2445.         begin
  2446.         write (writeFile, M_C[ind2, ind1]:10);
  2447.         end;
  2448.       writeln (writefile);
  2449.       end;
  2450.     write (writeFile, '               ');
  2451.     for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2452.     writeln (writeFile);
  2453.     writeln (writeFile);
  2454.  
  2455.     writeln (writeFile, 'The ''-''-to-G matrix is: ');
  2456.     writeln (writeFile);
  2457.     for ind1 :=2 to numSp do
  2458.       begin
  2459.       write (writefile, vNamSp[ind1]);
  2460.       for ind2 :=1 to ind1-1 do
  2461.         begin
  2462.         write (writeFile, M_G[ind2, ind1]:10);
  2463.         end;
  2464.       writeln (writefile);
  2465.       end;
  2466.     write (writeFile, '               ');
  2467.     for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2468.     writeln (writeFile);
  2469.     writeln (writeFile);
  2470.  
  2471.     writeln (writeFile, 'The ''-''-to-T matrix is: ');
  2472.     writeln (writeFile);
  2473.     for ind1 :=2 to numSp do
  2474.       begin
  2475.       write (writefile, vNamSp[ind1]);
  2476.       for ind2 :=1 to ind1-1 do
  2477.         begin
  2478.         write (writeFile, M_T[ind2, ind1]:10);
  2479.         end;
  2480.       writeln (writefile);
  2481.       end;
  2482.     write (writeFile, '               ');
  2483.     for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2484.     writeln (writeFile);
  2485.     writeln (writeFile);
  2486.  
  2487.     writeln (writeFile, 'The ''-''-to-''-'' matrix is: ');
  2488.     writeln (writeFile);
  2489.     for ind1 :=2 to numSp do
  2490.       begin
  2491.       write (writefile, vNamSp[ind1]);
  2492.       for ind2 :=1 to ind1-1 do
  2493.         begin
  2494.         write (writeFile, M__[ind2, ind1]:10);
  2495.         end;
  2496.       writeln (writefile);
  2497.       end;
  2498.     write (writeFile, '               ');
  2499.     for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2500.     writeln (writeFile);
  2501.     writeln (writeFile);
  2502.     end;
  2503.  
  2504.   if ((TypeOutput = 1) or (TypeOutput = 2)) then
  2505.     begin
  2506.     writeln (writeFile, 'THE MATRIX OF ', tira1, 'DISTANCE ESTIMATES IS :');
  2507.     writeln (writeFile);
  2508.     for ind1 :=2 to numSp do
  2509.       begin
  2510.       write (writeFile, vNamSp[ind1]);
  2511.       for ind2 :=1 to ind1-1 do
  2512.         begin
  2513.         write(writeFile, DistanceMatrix[ind2, ind1]:10:4);
  2514.         end;
  2515.       writeln (writeFile);
  2516.       end;
  2517.     write (writeFile, '               ');
  2518.     for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2519.     writeln (writeFile);
  2520.     writeln (writeFile);
  2521.  
  2522.     if ((dist=1) or (dist=2) or (dist=3) or (dist=6)) then
  2523.       begin
  2524.       writeln (writeFile, 'THE  MATRIX OF VARIANCES OF ', tira1, 'ESTIMATES IS :');
  2525.       writeln (writeFile);
  2526.       for ind1 :=2 to numSp do
  2527.         begin
  2528.         write (writeFile, vNamSp[ind1]);
  2529.         for ind2 :=1 to ind1-1 do
  2530.           begin
  2531.           write(writeFile, VarianceMatrix [ind2, ind1]:10:4);
  2532.           end;
  2533.         writeln (writeFile);
  2534.         end;
  2535.       write (writeFile, '               ');
  2536.       for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
  2537.       writeln (writeFile);
  2538.       writeln (writeFile);
  2539.       end;
  2540.     writeln (writefile, '***************************************************');
  2541.     writeln (writefile, '***************************************************');
  2542.     writeln (writefile);
  2543.     end;
  2544.   if (TypeOutput = 3) then
  2545.     begin
  2546.     writeln (writefile, NumSp);
  2547.     writeln (writeFile, vNamSp[1]);
  2548.     for ind1 :=2 to numSp do
  2549.       begin
  2550.       write (writeFile, vNamSp[ind1]);
  2551.       for ind2 :=1 to ind1-1 do
  2552.         begin
  2553.         write(writeFile, DistanceMatrix[ind2, ind1]:10:4);
  2554.         end;
  2555.       writeln (writeFile);
  2556.       end;
  2557.     writeln (writeFile);
  2558.     end;
  2559.   codeerror:= 0;
  2560.   end; (*of procedure*)
  2561.  
  2562.                                                                     (*BYE!!!*)
  2563. PROCEDURE TheEnd;
  2564.   begin
  2565.   textcolor (white);
  2566.   textbackground (black);
  2567.   writeln;
  2568.   writeln;
  2569.   writeln;
  2570.   writeln;
  2571.   writeln ('End of program.');
  2572.   writeln ('This program has been written by J. A. López Bueno.');
  2573.   writeln ('Department of Genetics.');
  2574.   writeln ('University of Valencia.');
  2575.   writeln ('C/ Dr. Moliner, n. 50, Burjassot, Valencia-46100, SPAIN.');
  2576.   writeln ('Suggestions, questions and/or bug reports will be wellcome.');
  2577.   writeln;
  2578.   end; (*of procedure*)
  2579.  
  2580. PROCEDURE Default;
  2581.   begin
  2582.   readpath  := 'sequence.seq';
  2583.   writepath := 'sequence.rst';
  2584.   format    := 1;
  2585.   dist      := 2;
  2586.   baswhich  := 1;
  2587.   tablewhich:= 1;
  2588.   typeoutput:= 1;
  2589.   end; (*of procedure*)
  2590.  
  2591. PROCEDURE DoCommandLine;
  2592.   var cexiste: boolean;
  2593.   begin
  2594.   Default;
  2595.   if ParamStr (1) <> '' then begin
  2596.                              ReadPath:= ParamStr (1);
  2597.                              end;
  2598.   cexiste:= FileExists (ReadPath);
  2599.   if cexiste=false then begin
  2600.                         writeln ('Error. I don''t find the input file...');
  2601.                         Halt;
  2602.                         end;
  2603.   if ParamStr (2) <> '' then begin
  2604.                              WritePath:= ParamStr (2);
  2605.                              end;
  2606.   if ParamStr (3) <> '' then begin
  2607.                              val (ParamStr(3), format, comerror);
  2608.                              if comerror <> 0 then
  2609.                                begin
  2610.                                writeln ('Error. Integer value expected...');
  2611.                                writeln ('The value must be> 0 and <=',MaxFor:3);
  2612.                                Halt;
  2613.                                end;
  2614.                              if ((format > MaxFor) or (format < 1)) then
  2615.                                begin
  2616.                                writeln ('Error. The value must be > 0 and <=',MaxFor:3);
  2617.                                Halt;
  2618.                                end;
  2619.                              end;
  2620.   if ParamStr (4) <> '' then begin
  2621.                              val (ParamStr(4), dist, comerror);
  2622.                              if comerror <> 0 then
  2623.                                begin
  2624.                                writeln ('Error. Integer value expected...');
  2625.                                writeln ('Value for distance must be> 0 and <=',MaxDist:3);
  2626.                                Halt;
  2627.                                end;
  2628.                              if ((dist > MaxDist) or (dist < 1)) then
  2629.                                begin
  2630.                                writeln ('Error. Value for distance must be > 0 and <=',MaxDist:3);
  2631.                                Halt;
  2632.                                end;
  2633.                              end;
  2634.   if ParamStr (5) <> '' then begin
  2635.                              val (ParamStr(5), baswhich, comerror);
  2636.                              if comerror <> 0 then
  2637.                                begin
  2638.                                writeln ('Error. Integer value expected...');
  2639.                                writeln ('Value for bases must be > 0 and <=',MaxWhich:3);
  2640.                                Halt;
  2641.                                end;
  2642.                              if ((BasWhich > MaxWhich) or (BasWhich < 1)) then
  2643.                                begin
  2644.                                writeln ('Error. Value for bases must be > 0 and <=',MaxWhich:3);
  2645.                                Halt;
  2646.                                end;
  2647.                              end;
  2648.   if ParamStr (6) <> '' then begin
  2649.                              val (ParamStr(6), tablewhich, comerror);
  2650.                              if comerror <> 0 then
  2651.                                begin
  2652.                                writeln ('Error. Integer value...');
  2653.                                writeln ('Value for code table must be > 0 and <=',MaxTable:3);
  2654.                                Halt;
  2655.                                end;
  2656.                              if ((TableWhich > MaxTable) or (TableWhich < 1)) then
  2657.                                begin
  2658.                                writeln ('Error. Value for code table must be > 0 and <=',MaxTable:3);
  2659.                                Halt;
  2660.                                end;
  2661.                              end;
  2662.   if ParamStr (7) <> '' then begin
  2663.                              val (ParamStr(7), typeoutput, comerror);
  2664.                              if comerror <> 0 then
  2665.                                begin
  2666.                                writeln ('Error. Integer value expected...');
  2667.                                writeln ('Value for output must be > 0 and <=',MaxOutput:3);
  2668.                                Halt;
  2669.                                end;
  2670.                              if ((TypeOutput > MaxOutput) or (TypeOutput < 1)) then
  2671.                                begin
  2672.                                writeln ('Error. Value for output must be > 0 and <=',MaxOutput:3);
  2673.                                Halt;
  2674.                                end;
  2675.                              end;
  2676.   end;
  2677.  
  2678. BEGIN
  2679. checkbreak:= true; SetCBreak (true);
  2680. setchar:= ['A','a','C','c','T','t','G','g','U','u','-'];
  2681. codeerror:= 0;
  2682. OldExitProcAddress:= ExitProc;
  2683. ExitProc:= @MyExitProcedure;
  2684. if ParamCount < 1 then                                 (*MENU DRIVEN PROGRAM*)
  2685.   begin
  2686.   mimodo:= mmenu;
  2687.   CursorOff;
  2688.   ending:= false;
  2689.   flagreadfile:= false;
  2690.   ClrScr;
  2691.   Beep (300,100);
  2692.   numventana:= 1;
  2693.   careful:= -1;
  2694.   GotoXY (20,6);
  2695.   write ('  DISTANCE 3.0. 1993  J.A. López Bueno');
  2696.   OtherWindow (20, 7, 59, 21);
  2697.   numventana:= 0;
  2698.   TextBackGround (WindowForeColor);
  2699.   TextColor (yellow);
  2700.   clrscr;
  2701.   oopt:= 1;
  2702.   Inicializa_Ptr;
  2703.   Default;
  2704.   firstime:= true;
  2705.   setkey:= [Enter,Esc, UpArrow, DoArrow];
  2706.   MakeList;
  2707.   repeat
  2708.     repeat
  2709.       wwell := false;
  2710.       GotoXY(2,1); begin
  2711.                    textcolor (green);
  2712.                    Write ('            MAIN MENU:');
  2713.                    textcolor (yellow);
  2714.                    end;
  2715.       GotoXY(2,2);
  2716.       GotoXY(2,3); begin
  2717.                    if oopt=1 then begin
  2718.                                   textbackground (black);
  2719.                                   textcolor (green);
  2720.                                   end;
  2721.                    Write ('Path and name of the sequences file.');
  2722.                    textbackground (WindowForeColor); textcolor (yellow);
  2723.                    end;
  2724.       GotoXY(2,4); begin
  2725.                    if oopt=2 then begin
  2726.                                   textbackground (black);
  2727.                                   textcolor (green);
  2728.                                   end;
  2729.                    Write ('Path and name of the results file.');
  2730.                    textbackground (WindowForeColor); textcolor (yellow);
  2731.                    end;
  2732.       GotoXY(2,5); begin
  2733.                    if oopt=3 then begin
  2734.                                   textbackground (black);
  2735.                                   textcolor (green);
  2736.                                   end;
  2737.                    Write ('Format of your aligned file.');
  2738.                    textbackground (WindowForeColor); textcolor (yellow);
  2739.                    end;
  2740.       GotoXY(2,6); begin
  2741.                    if oopt=4 then begin
  2742.                                   textbackground (black);
  2743.                                   textcolor (green);
  2744.                                   end;
  2745.                    Write ('Method to compute distances.');
  2746.                    textbackground (WindowForeColor); textcolor (yellow);
  2747.                    end;
  2748.       GotoXY(2,7); begin
  2749.                    if oopt=5 then begin
  2750.                                   textbackground (black);
  2751.                                   textcolor (green);
  2752.                                   end;
  2753.                    Write ('Bases in each codon to use.');
  2754.                    textbackground (WindowForeColor); textcolor (yellow);
  2755.                    end;
  2756.       GotoXY(2,8); begin
  2757.                    if oopt=6 then begin
  2758.                                   textbackground (black);
  2759.                                   textcolor (green);
  2760.                                   end;
  2761.                    Write ('Table of genetic code.');
  2762.                    textbackground (WindowForeColor); textcolor (yellow);
  2763.                    end;
  2764.       GotoXY(2,9); begin
  2765.                    if oopt=7 then begin
  2766.                                   textbackground (black);
  2767.                                   textcolor (green);
  2768.                                   end;
  2769.                    Write ('Output.');
  2770.                    textbackground (WindowForeColor); textcolor (yellow);
  2771.                    end;
  2772.       GotoXY(2,10);begin
  2773.                    if oopt=8 then begin
  2774.                                   textbackground (black);
  2775.                                   textcolor (green);
  2776.                                   end;
  2777.                    Write ('Do it !!!');
  2778.                    textbackground (WindowForeColor); textcolor (yellow);
  2779.                    end;
  2780.       GotoXY(2,11);begin
  2781.                    if oopt=9 then begin
  2782.                                   textbackground (black);
  2783.                                   textcolor (green);
  2784.                                   end;
  2785.                    Write ('Help.');
  2786.                    textbackground (WindowForeColor); textcolor (yellow);
  2787.                    end;
  2788.       GotoXY(2,12);begin
  2789.                    if oopt=10 then begin
  2790.                                    textbackground (black);
  2791.                                    textcolor (green);
  2792.                                    end;
  2793.                    Write ('Quit.');
  2794.                    textbackground (WindowForeColor); textcolor (yellow);
  2795.                    end;
  2796.       ReadingKey (kkey, setkey);
  2797.       case kkey of
  2798.         UpArrow: begin Dec (oopt); if oopt<1 then oopt:= MaxOptPri; end;
  2799.         DoArrow: begin Inc (oopt); if oopt>MaxOptPri then oopt:=1; end;
  2800.         Enter  : wwell:= true;
  2801.        end;
  2802.     until wwell=true;
  2803.     case oopt of
  2804.       1: begin
  2805.          PointInt^:= PointPant^;
  2806.          PathReadFile;
  2807.          if pathch<>Esc then begin flagreadfile:= true; firstime:= false; end
  2808.            else flagreadfile:= false;
  2809.          PointPant^:= PointInt^;
  2810.          window (21, 8, 58, 19);
  2811.          end;
  2812.       2: begin
  2813.          PointInt^:= PointPant^;
  2814.          careful:= 0;
  2815.          Repeat
  2816.            PathWriteFile;
  2817.          until careful<>3;
  2818.          PointPant^:= PointInt^;
  2819.          window (21, 8, 58, 19);
  2820.          end;
  2821.       3: begin
  2822.          PointInt^:= PointPant^;
  2823.          AskFormat (format);
  2824.          PointPant^:= PointInt^;
  2825.          window (21, 8, 58, 19);
  2826.          end;
  2827.       4: begin
  2828.          PointInt^:= PointPant^;
  2829.          AskMethod (dist);
  2830.          PointPant^:= PointInt^;
  2831.          window (21, 8, 58, 19);
  2832.          end;
  2833.       5: begin
  2834.          PointInt^:= PointPant^;
  2835.          AskWhich (baswhich);
  2836.          PointPant^:= PointInt^;
  2837.          window (21, 8, 58, 19);
  2838.          end;
  2839.       6: begin
  2840.          PointInt^:= PointPant^;
  2841.          AskCodonTableWhich (tablewhich);
  2842.          PointPant^:= PointInt^;
  2843.          window (21, 8, 58, 19);
  2844.          end;
  2845.       7: begin
  2846.          PointInt^:= PointPant^;
  2847.          AskOutput (typeoutput);
  2848.          PointPant^:= PointInt^;
  2849.          window (21, 8, 58, 19);
  2850.          end;
  2851.       8: begin
  2852.          PointInt^:= PointPant^;
  2853.          Presentation;
  2854.          if ((flagreadfile=true) and (firstime=false)) then
  2855.            begin
  2856.            if careful=-1 then
  2857.              begin
  2858.              writeln;
  2859.              writeln ('                       ¡¡¡  NO FILE FOR OUTPUT  !!!                        ');
  2860.              writeln;
  2861.              delay (1500);
  2862.              end
  2863.            else
  2864.              begin
  2865.              if ((format=1) or (format=2)) then
  2866.                begin
  2867.                ReadOptions;
  2868.                CheckOptions;
  2869.                end;
  2870.              FreeList;
  2871.              case format of
  2872.                1 : ReadingFileNewPhy (readpath);
  2873.                2 : ReadingFileOldPhy (readpath);
  2874.                3 : ReadingFileMSF (readpath);
  2875.               end;
  2876.              InitVars;
  2877.              MakingMatrix;
  2878.              MakLenghtComMatrix;
  2879.              MakDistanceMatrix;
  2880.              if ((baswhich=1) and (tablewhich<>1)) then
  2881.                begin
  2882.                ReadingCodonTable (tablewhich);
  2883.                MakSyn_NonSynMatrix;
  2884.                end;
  2885.              assign (writeFile, writePath);
  2886.              if ((careful=0) or (careful=1)) then Rewrite (writeFile);
  2887.              if careful=2 then Append (writeFile);
  2888.              careful:= 2;
  2889.              WritingResults;
  2890.              close (writeFile);
  2891.              end;
  2892.            end
  2893.          else
  2894.            begin
  2895.            TextColor (Mensaje);
  2896.            beep (300, 100);
  2897.            writeln;
  2898.            writeln ('                       ¡¡¡  NO FILE TO READ  !!!                        ');
  2899.            writeln;
  2900.            delay (1500);
  2901.            clrscr;
  2902.            TextColor (WindowTextColor);
  2903.            end;
  2904.          PointPant^:= PointInt^;
  2905.          window (21, 8, 58, 19);
  2906.          end;
  2907.       9: begin
  2908.          PointInt^:= PointPant^;
  2909.          HelpScreen;
  2910.          PointPant^:= PointInt^;
  2911.          window (21, 8, 58, 19);
  2912.          end;
  2913.      10: ending:= true;
  2914.       end;
  2915.   until ending= true;
  2916.   textbackground (black);
  2917.   textcolor (white);
  2918.   window (1, 1, 80, 25);
  2919.   clrscr;
  2920.   CursorOn;
  2921.   ClrScr;
  2922.   TheEnd;
  2923.   end
  2924. else                                                (*COMMAND DRIVEN PROGRAM*)
  2925.   begin
  2926.   mimodo:= mcomando;
  2927.   if ((ParamStr(1)='/h') or (ParamStr(1)='/H')) then HelpCommandLine
  2928.   else begin
  2929.        writeln;
  2930.        writeln ('  DISTANCE 3.0. 1993  J.A. López Bueno (command mode)');
  2931.        DoCommandLine;
  2932.        Inicializa_Ptr;
  2933.        MakeList;
  2934.        if ((format=1) or (format=2)) then
  2935.          begin
  2936.          ReadOptions;
  2937.          CheckOptions;
  2938.          end;
  2939.        case format of
  2940.          1 : ReadingFileNewPhy (readpath);
  2941.          2 : ReadingFileOldPhy (readpath);
  2942.          3 : ReadingFileMSF (readpath);
  2943.         end;
  2944.        InitVars;
  2945.        MakingMatrix;
  2946.        MakLenghtComMatrix;
  2947.        MakDistanceMatrix;
  2948.        if ((baswhich=1) and (tablewhich<>1)) then
  2949.          begin
  2950.          ReadingCodonTable (tablewhich);
  2951.          MakSyn_NonSynMatrix;
  2952.          end;
  2953.        assign (writeFile, writePath);
  2954.        Rewrite (writeFile);
  2955.        WritingResults;
  2956.        close (writeFile);
  2957.        FreeList;
  2958.        TheEnd;
  2959.        end;
  2960.   end;
  2961. END. (*of program*)
  2962.