home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / mbug / mbug027.arc / TTINPUT.INC < prev    next >
Text File  |  1979-12-31  |  5KB  |  166 lines
  1. OVERLAY PROCEDURE Update(Date : str14);
  2. (*  Update is used to update the data base *)
  3. VAR
  4.   Ch    : CHAR;
  5.   k,ok2 : INTEGER;
  6.   I,D,Ptr   : integer;
  7.  
  8. PROCEDURE InputAnimal(VAR Animal : Animal_Rec; VAR ch : CHAR);
  9. CONST
  10.   Term : CharSet  =  [^E,^I,^M,^X,^Z,#27];
  11. VAR
  12.   L        : INTEGER;
  13.   TC       : CHAR;
  14.   ear      : str5;
  15.  
  16. PROCEDURE get_parents;
  17. VAR
  18.   dummy1 : str1;
  19.   ch     : CHAR;
  20.   k      : INTEGER;
  21. BEGIN
  22.   dummy1 := '';
  23.   k     := 0;
  24.   Read(kbd,dummy1);
  25.   val(dummy1,k,ok2);
  26.   IF k IN [1..6]
  27.     THEN
  28.       BEGIN
  29.         WITH  Animal_Table[k] DO
  30.           BEGIN
  31.             ch := sex;
  32.             CASE ch OF
  33.               'M' : BEGIN
  34.                       if L <> 13 then
  35.                       begin
  36.                         Animal.sire := Ear_No;
  37.                         dis(23,7,name);
  38.                         ClrEOL;
  39.                       end;
  40.                       if L = 13 then
  41.                       BEGIN
  42.                         Animal.partner := Ear_No;
  43.                         dis(57,14,name);
  44.                       end;
  45.                     END;
  46.               'F' : BEGIN
  47.                       if L <> 13 then
  48.                       Animal.dam := Ear_No;
  49.                       dis(23,8,name);
  50.                       ClrEOL;
  51.                     END;
  52.             END;{case}
  53.           END;{with}
  54.       END;{ K in [1..6]}
  55. END;
  56.  
  57. BEGIN
  58.   L := 1;
  59.   ear := '';
  60.   WITH Animal DO
  61.     REPEAT
  62.       CASE L OF
  63.         1 : BEGIN
  64.                 dis(1,17,foot3);
  65.                 InputStr(Ear_No,5,22,3,term,tc);
  66.                 Ear_No := UpcaseStr(Ear_No);
  67.                 Fillup(Ear_No);
  68.             END;
  69.         2 : InputStr(Name,20,46,3,term,tc);
  70.         3 : BEGIN
  71.               dis(1,17,foot3);
  72.               InputStr(sex,1,75,3,term,tc);
  73.               IF sex <> ''
  74.                 THEN
  75.                   IF (sex IN ['m','M','f','F'])
  76.                     THEN
  77.                       sex := UpCase(sex)
  78.                     ELSE
  79.                       sex := '';
  80.             END;
  81.         4 : BEGIN
  82.               dis(1,17,foot4);
  83.               GotoXY(23,5);
  84.               Write(Date_Born);
  85.               getdate(date_born,4);
  86.             END;
  87.         5 : BEGIN
  88.               dis(1,17,foot4);
  89.               GotoXY(23,6);
  90.               Write(Date_Died);
  91.               getdate(date_died,5);
  92.             END;
  93.       8,7 : BEGIN
  94.               dis(1,17,foot3);;
  95.               LowVideo;
  96.               GotoXY(1,7);
  97.               write('Selete from ');
  98.               gotoXY(1,8);
  99.               write('Parent table.');
  100.               NormVideo;
  101.               GotoXY(13,7);
  102.               get_parents;
  103.               IF sire = ''
  104.                 THEN BEGIN
  105.                        sire := '!000M';
  106.                        dis(23,7,'Un Known Male');
  107.                        ClrEOL;
  108.                   END;
  109.               IF dam  = ''
  110.                 THEN BEGIN
  111.                        dam  := '!000F';
  112.                        dis(23,8,'Un Known Female');
  113.                        ClrEOL;
  114.                   END;
  115.               GotoXY(1,7); write('              ');
  116.               GotoXY(1,8); write('              ');
  117.             END;
  118.         9 : InputStr(Comment_1,40,15,9,term,tc);
  119.         10: InputStr(Comment_2,40,15,10,term,tc);
  120.         11: begin
  121.               dis(1,17,foot3);
  122.               InputStr(Comment_3,40,15,11,term,tc);
  123.             end;
  124.         12: if sex = 'F' then
  125.               BEGIN
  126.                 dis(1,17,foot4);
  127.                 getdate(date_mated,13);
  128.               END
  129.               ELSE
  130.                 TC := ^X;
  131.         13: IF sex = 'F' THEN
  132.               BEGIN
  133.                 dis(1,17,foot3);
  134.                 LowVideo;
  135.                 gotoxy(40,14);
  136.                 write('P/Table');
  137.                 NormVideo;
  138.                 gotoxy(57,14);
  139.                 get_parents;
  140.                 gotoxy(40,14);
  141.                 write('        ');
  142.               END
  143.               ELSE
  144.               begin
  145.                 if TC = ^E then L := 11 else
  146.                 TC := ^X;
  147.               end;
  148.       END; {Case of L}
  149.       CASE TC OF
  150.         ^M,^I,^X
  151.              : BEGIN
  152.                  L := L + 1;
  153.                  IF L = 14
  154.                    THEN L := 1;
  155.                END;
  156.         ^E    : BEGIN
  157.                   L := L - 1;
  158.                   IF L = 0
  159.                     THEN L := 13;
  160.                 END;
  161.       END; {case of TC}
  162.     UNTIL (TC = ^Z) OR (TC = #27);
  163.   ch := TC;
  164. END;
  165.  
  166.