home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol133 / buildf.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  3.6 KB  |  162 lines
  1. EXTERNAL EDITFILE::BUILD(1);
  2.  
  3. Function INREC (j,i,l: INTEGER): integer;
  4. {
  5. GLOBAL
  6.     valid_build : boolean }
  7. LABEL    10;
  8. VAR    Alfa : STRING 20;
  9.     valid : boolean;
  10. begin
  11.   REPEAT
  12.     valid := false;
  13.     IF j>99 then
  14.       begin
  15.     j := 200;
  16.     {exit} goto 10
  17.       end;
  18.     If  (j=0) or (j=1) or (j=2) or
  19.     (j=4) or (j=6) or (j=99) then
  20.       begin{If valid}
  21.         valid := true;
  22.     NBUFFER.tag := j ;
  23.     WITH NBUFFER DO
  24.       CASE TAG OF
  25.       0:    begin
  26.         SETLENGTH(NAME,0);
  27.                 writeln('                      ____________________');
  28.         write(' Program Name........ ');
  29.         READLN(ALFA);
  30.         If Length(ALFA)>20 then SETLENGTH(ALFA,20);
  31.         APPEND(NAME,ALFA);
  32.         write(' No. Nutrients..(integer). ');
  33.         READLN(N1);
  34.         write(' No. Feeds...(integer).... ');
  35.         READLN(N2);
  36.         N2 := N2 + N1;    {must account for surplus accounts}
  37.         end;
  38.       1:    begin
  39.         writeln;
  40.         writeln('Make any identifying notes about this data');
  41.         write(' Header..(notes) ');
  42.         READLN(header)
  43.         end;
  44.       2:    begin
  45.         writeln('                         ____________________');
  46.         write(' Nutrient Name..(char).. ');
  47.         READLN(RNAME);
  48.         RINDEX := i;
  49.         write(' Nutrient Requirement ..(real #).. ');
  50.         READLN(RHS)
  51.         end;
  52.       4:    begin
  53.         writeln('                          ____________________');
  54.         write(' Feed Name ..(char)...... ');
  55.         READLN(CNAME);
  56.         CINDEX := i;
  57.         write(' Cost ................$');
  58.         READLN(OBJ)
  59.         end;
  60.       6:    begin
  61.         writeln;
  62.         R := l;
  63.         S := i;
  64.         write(' Feed #',i:3,' Nutrient #',l:3,' ..(real #). ');
  65.         READLN(T)
  66.         end;
  67.       99:   valid_build := true
  68.       End{With/CASE}
  69.       end{If valid}
  70.     Else
  71.       Write('INVALID TAG, Reenter ---> ')
  72.   UNTIL valid{TAG};
  73. 10: INREC := j
  74. End{of INREC};
  75.  
  76. Procedure BUILD;
  77. VAR    FX : LINEAR;
  78.      i,k,l,
  79.      n1count,n2count,
  80.      N : INTEGER;
  81. begin
  82.   GETID(NFIL,' Build what File? ');
  83.   REWRITE(NFIL, FX);      (*---REWRITE( <FID> , <FCB> )---*)
  84.   valid_build := false;
  85.   N := 0;
  86.   While (N < 100) DO
  87.     begin
  88.       {start building.  One 0-tag required, only one allowed}
  89.       k := 0;
  90.       N := INREC(k,i,l);
  91.       n1count := NBUFFER.N1;    {need these below}
  92.       n2count := NBUFFER.N2 - n1count;{take the surplus accounts back out}
  93.       write(FX, NBUFFER);
  94.       {continue building.  One 1-tag comment allowed}
  95.       k := 1;
  96.       N := INREC(k,i,l);
  97.       write(FX, NBUFFER);
  98.       {continue building.  Each nutrient requires one 2-tag.}
  99.       k := 2;
  100.       for i := 1 to n1count do
  101.     begin
  102.     N := INREC(k,i,l);
  103.     write(fx,nbuffer);
  104.     end;    {for n1count loop}
  105.       {continue building. Each feed requires one 4-tag (name & cost)
  106.     and one 6-tag for each nutrient}
  107.       for i := 1 to n2count do    {# feeds}
  108.     begin
  109.     k := 4;        {4-tag, one per feed}
  110.     N := INREC(k, i, l);
  111.     write(fx,nbuffer);
  112.         writeln('Enter the nutrient analysis for this feed; ');
  113.     writeln('  nutrients are numbered in the order you entered them.');
  114.     for l := 1 to n1count do    {# nutrients}
  115.       begin
  116.       k := 6;
  117.       N := INREC(k, i, l);
  118.       write(fx,nbuffer);
  119.       end;    {n1count}
  120.     end;    {n2count}
  121.  
  122.       for i := 1 to n1count do
  123.       {dummy surplus records with 4-tags}
  124.     begin
  125.     with NBUFFER do
  126.       begin
  127.       tag := 4;
  128.       cname := '        surplus     ';
  129.       cindex := n2count + i;
  130.       obj := 0.0;
  131.       end;    {with}
  132.     write(fx,nbuffer);
  133.     end;    {for}
  134. {insert  6-tag records here.  dummies} 
  135.       for i := 1 to n1count do
  136.     begin
  137.     with nbuffer do
  138.       begin
  139.       tag := 6;
  140.       R := i;
  141.       S := i + n2count;
  142.       T := -1.0;
  143.       end;    {with}
  144.     write(fx,nbuffer);
  145.     end;    {for}
  146.       {end it all, 99-tag}
  147.       k := 99;
  148.       N := INREC(k,i,l);
  149.     If (N<100) then
  150.        Write(FX, NBUFFER);
  151.     If (N=99) AND valid_build then{finished}
  152.       N:=200
  153.     Else
  154.       If (N>99) AND (not valid_build) then
  155.         begin
  156.         writeln('You MUST enter a TAG record of 99');
  157.         N := 0
  158.         end
  159.     end{while}
  160. End{of build};
  161.  .
  162.