home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / mbug / mbug027.arc / LIST.INC < prev    next >
Text File  |  1979-12-31  |  5KB  |  172 lines
  1. overlay PROCEDURE List(date : str14);
  2.  
  3. LABEL
  4.   escape;
  5.  
  6. VAR
  7.   i,l,k,ok : INTEGER;
  8.   Bottom   : INTEGER;
  9.   rec      : INTEGER;
  10.   ch       : CHAR;
  11.   bl       : charset;
  12.   ear      : str5;
  13.   Animal   : Animal_rec;
  14.   yy,ww,dd : INTEGER;
  15.   ok2      : BOOLEAN;
  16.  
  17. PROCEDURE Movecurs(ch : CHAR; VAR G : INTEGER);
  18. VAR
  19.   old : INTEGER;
  20. BEGIN
  21.   old := G;
  22.   CASE ch OF
  23.     ^E  : BEGIN
  24.             G := G -1;
  25.             IF g = 3
  26.               THEN g := bottom + 3;
  27.           END;
  28.     ^X  : BEGIN
  29.             G := G + 1;
  30.             IF g = bottom + 4
  31.               THEN g := 4;
  32.           END;
  33.     ^Q  : G := 4;
  34.    END; {Case of ch}
  35.   dis(1,old,'  ');
  36.   dis(1,G,'->');
  37. END;
  38.  
  39. BEGIN
  40.   IF (filesize(infile) = 0) THEN GOTO escape;
  41.   RESET(infile);
  42.   rec := 0;
  43.   line(1);
  44.   dis(1,2,'LIST     NAME                EAR NUMBER    SEX        AGE');
  45.   ClrEOL;
  46.   Display_Recs_Used;
  47.   line(16);
  48.   l := 4;
  49.   REPEAT
  50.     ear := '';
  51.     dis(1,5,'Press RETURN to LIST ALL or type Starting Ear No. _____');
  52.     InputStr(ear,5,50,4,[^M,^Z,^X,^E],ch);
  53.     IF ear <> '' THEN
  54.         BEGIN
  55.           ear := UpCaseStr(ear);
  56.           fillup(ear);
  57.           find_ear(rec,ear);
  58.           IF (NOT found) THEN
  59.               BEGIN
  60.                 Writeln;
  61.                 Writeln('Ear Number Not Found');
  62.               END;
  63.         END;
  64.   UNTIL found OR (ear = '');
  65.   ClearFrame;
  66.   seek(infile,rec);
  67.   Bottom := 0;
  68.   dis(1,17,'   |   |   |   |   |   | S = Screen | P = Printer   | <ESC> = MAIN   MENU |');
  69.   BL := ['P','S',#27,^M];
  70.   select(75,17,' ',BL,Ch);
  71.   IF ch = #27 THEN GOTO escape;
  72.   IF ch = 'P' THEN
  73.       BEGIN
  74.         Writeln(lst);
  75.         Writeln(lst,'                       LIST of Animals on the ',date_Today);
  76.         Writeln(lst,'   Name            Ear No  Sex  Sire   Dam         Birth         Death');
  77.         Writeln(lst);
  78.         REPEAT
  79.           Read(infile,Animal);
  80.           WITH Animal DO
  81.             BEGIN
  82.               Write(lst,name,' ':20 -(Length(name)),ear_no,sex: 4,sire: 7,dam: 7);
  83.               Writeln(lst,date_born:14,date_died:14);
  84.             END;
  85.           l := l + 1;
  86.           IF l = 57 THEN
  87.               BEGIN
  88.                 Write('Press RETURN to continue.':50);
  89.                 Readln;
  90.                 Writeln(lst);
  91.                 Writeln(lst,'                       LIST of Animals on the ',date_Today);
  92.                 Writeln(lst,'   Name            Ear No  Sex  Sire   Dam         Birth         Death');
  93.                 Writeln(lst);
  94.                 l := 4;
  95.               END;
  96.         UNTIL (EOF(infile));
  97.         Writeln(lst);
  98.       END;
  99.   l := 4;
  100.   rec := 0;
  101.   RESET(infile);
  102.   REPEAT
  103.     IF  (filesize(infile) <= 12) THEN
  104.         BEGIN
  105.           dis(1,17,'   |   |   |   |   |   |          |                 | <ESC> = MAIN   MENU');
  106.           bl := [#27,^E,^X,^Q,'1','2','3','4','5','6'];
  107.         END;
  108.     IF (rec <= 12) AND (filesize(infile) > 12) THEN
  109.         BEGIN
  110.           dis(1,17,'   |   |   |   |   |   |          | N = Next screen | <ESC> = MAIN   MENU');
  111.           bl := ['N',#27,^E,^X,^Q,'1','2','3','4','5','6'];
  112.         END;
  113.     IF (rec > 12) THEN
  114.         BEGIN
  115.           dis(1,17,'   |   |   |   |   |   | B = Back | N = Next screen | <ESC> = MAIN   MENU');
  116.           bl := ['B','N',#27,^E,^X,^Q,'1','2','3','4','5','6'];
  117.         END;
  118.     seek(infile,rec);
  119.     Read(infile,Animal);
  120.     Bottom := Bottom + 1;
  121.     rec := rec + 1;
  122.     list_table[bottom ] := Animal;
  123.     WITH Animal DO
  124.       BEGIN
  125.         dis(4,L,name);
  126.         dis(30,L,Ear_no);
  127.         dis(45,L,sex);
  128.         yy := 0;
  129.         ww := 0;
  130.         dd := 0;
  131.         verify_date(Date_Born,ok2);
  132.         IF ok2 THEN
  133.             BEGIN
  134.               verify_date(Date_Died,ok2);
  135.               IF ok2
  136.                  THEN age(Date_Born,Date_Died,yy,ww,dd)
  137.                  ELSE age(Date_Born,Date,yy,ww,dd);
  138.               GotoXY(50,L);
  139.               IF yy > 0
  140.                 THEN Write(YY:2,' Years',ww:3,' Weeks',dd:3,' Days')
  141.                 ELSE Write(ww:2,' Weeks',dd:3,' Days');
  142.             END;
  143.       END;
  144.     L := L + 1;
  145.     IF (l = 16) OR (rec = Filesize(infile)) THEN
  146.         BEGIN
  147.           i := 4;
  148.           f_table;
  149.           REPEAT
  150.             movecurs(ch,i);
  151.             select(74,17,' ',BL,Ch);
  152.             IF ch = #27 THEN GOTO escape;
  153.               k := 0;
  154.               val(ch,k,ok);
  155.               IF k IN [1..6] THEN
  156.                   Animals_table(k,list_table[i-3]);
  157.           UNTIL (ch = 'N') OR (ch = 'B');
  158.           IF ch = 'B' THEN
  159.               BEGIN
  160.                 rec := rec - (12 + bottom);
  161.                 IF rec < 1  THEN rec := 0;
  162.               END;
  163.           IF rec = filesize(infile)  THEN rec := 0;
  164.           Bottom := 0;
  165.           ClearFrame;
  166.           l := 4;
  167.         END;
  168.   UNTIL (ch = #27);
  169.   escape:
  170.   close(infile);
  171. END;
  172.