{$C-}
   const
       Changed : Boolean = False;
      DiskFull : Boolean = False;
   type
       Entry = Record
                         Name : String[34];
                   Ingredient : Array[1..15] of String[20];
                    Direction : Array[1..13] of String[79];
               end;
       Str12 = String[12];
       Str80 = String[80];
   var
        RecipeFile : File of Entry;
            Recipe : Entry;
        TestString : Str80;
       CurrentFile : Str12;
       CurrentType : String[30];
            Choice : Char;
          Continue : Char;
            Option : Integer;
     HighestRecord : Integer;
   function Exist(FileName : Str12) : Boolean;
       var
           Fil : File;
       begin
           Assign(Fil, FileName);
           {$I-} Reset(Fil) {$I+};
           Exist := (IOresult = 0)
       end;
   procedure DrawStatusLine;
       begin
           GotoXY(1,21); Write(' ==============================================================================');
           GotoXY(1,23); Write(' ==============================================================================');
       end;
   procedure WriteStatusLine(Status : Str80);
       var
           Margin : Integer;
       begin
           Margin := ((80-length(Status)) div 2);
           GotoXY(1,22); ClrEol;
           GotoXY(Margin,22); Write(^G,Status + '  ');
       end;
   procedure DrawMask;
       begin
           GotoXY(8,1); Write('NAME :');
           GotoXY(1,2); Write('INGREDIENTS :');
           GotoXY(2,7); Write('DIRECTIONS :');
       end;
   procedure DrawScreen;
       var
          A,B,J  : Integer;
       begin
           With Recipe do
           begin
               GotoXY(14,1);ClrEol;Write(Name);
               A := 14; B := 2;
               For J := 1 to 15 Do
               begin
                   GotoXY(A,B);Write('                    '); GotoXY(A,B);
                   Write(Ingredient[J]); A := A + 22;
                   If A = 80 then
                   begin
                       A := 14; B := B + 1;
                   end;
               end;
               B := 8;
               For J := 1 to 13 Do
               begin
                   GotoXY(1,B); ClrEol; Write(Direction[J]);
                   B := B + 1;
               end;
           end;
       end;
   procedure Accept;
       begin
           Assign(RecipeFile,CurrentFile);
           If not Exist(CurrentFile) then Rewrite(RecipeFile)
           else Reset(RecipeFile);
           With Recipe Do
           begin
               {$I-} Seek(RecipeFile, FileSize(RecipeFile)) {$I+};
               DiskFull := (IOresult = $F0);
               If DiskFull then
               begin
                   WriteStatusLine('DISK FULL !!!  Erase Unnecessary Files.  (ANY KEY) to QUIT.');
                   Read(Continue); Halt;
               end;
               Write(RecipeFile,Recipe);
               Flush(RecipeFile);
               Close(RecipeFile);
           end;
           Changed := False;
       end;
   procedure Change;
       var
           X,Y,I : Integer;
       begin
           With Recipe Do
           begin
               GotoXY(14,1); Read(TestString);
               If TestString <> '' then
               begin
                   Changed := True;
                   Name := TestString;
                   DrawScreen;
               end;
               X := 14; Y := 2;
               For I := 1 to 15 Do
               begin
                   GotoXY(X,Y); Read(TestString);
                   If TestString <> '' then
                   begin
                       Changed := True;
                       Ingredient[I] := TestString;
                       DrawScreen;
                   end;
                   X := X + 22;
                   If X = 80 then
                   begin
                       X := 14; Y := Y + 1;
                   end;
               end;
               Y := 8;
               For I := 1 to 13 Do
               begin
                   GotoXY(1,Y); Read(TestString);
                   If TestString <> '' then
                   begin
                       Changed := True;
                       Direction[I] := TestString;
                       DrawScreen;
                   end;
                   Y := Y + 1;
               end;
           end;
       end;
   procedure FindRecipe(Rec : Integer);
       begin
           Assign(RecipeFile,CurrentFile);
           Reset(RecipeFile);
           With Recipe Do
           begin
               Seek(RecipeFile,Rec);
               Read(RecipeFile,Recipe);
               Close(RecipeFile);
           end;
       end;
   procedure PrintRecipe;
       var
           A,B,J : Integer;
          Blanks : String[25];
       begin
           Blanks := '                         ';
           WriteStatusLine('Printer ON Then Press (RETURN)');
           Read(Continue);
           With Recipe Do
           begin
               Writeln(Lst,'NAME : ',Name); Writeln(Lst);
               Writeln(Lst,'INGREDIENTS :');
               For J := 1 to 15 Do
               begin
                   Write(Lst,Ingredient[J] + Copy(Blanks,1,(25 - length(Ingredient[J]))));
                   If J mod 3 = 0 then
                       Write(Lst,^M^J);
               end;
               Writeln(Lst);
               Writeln(Lst,'DIRECTIONS :');
               For J := 1 to 13 Do
               begin
                   Writeln(Lst,Direction[J]);
               end;
               Writeln(Lst,#12);
           end;
       end;
   procedure DisplayRecipe(Number : Integer);
       begin
           If Number > HighestRecord then
           begin
               WriteStatusLine('That Recipe Does NOT Exist.  (ANY KEY) to Continue.');
               Read(Continue); Exit;
           end;
           With Recipe Do
           begin
               FindRecipe(Number);
               ClrScr;
               DrawMask;
               DrawStatusLine;
               DrawScreen;
               WriteStatusLine('(P)rint      (ANY KEY) for MENU');
               Read(Choice);
               If (Choice = 'P') or (Choice = 'p') then
                   PrintRecipe
               else
                   Exit;
           end;
       end;
   procedure ListNames;
       var
           I,X,Y : Integer;
       begin
           ClrScr; DrawStatusLine;
           GotoXY(((80 - length(CurrentType)) div 2),3);
           Write(CurrentType); X := 1; Y := 5;
           For I := 1 to 30 Do
           begin
               GotoXY(X,Y); Write(I:2,': ');
               If I = 15 then
               begin
                   X := 41; Y := 4;
               end;
               Y := Y + 1;
           end;
           If not Exist(CurrentFile) then
           begin
               WriteStatusLine('That File Does NOT Exist.  (ANY KEY) to Continue.');
               Read(Kbd,Continue); Exit;
           end;
           Assign(RecipeFile,CurrentFile);
           Reset(RecipeFile);
           I := 0; X := 5; Y := 5;
           With Recipe Do
           begin
               Repeat
                   Seek(RecipeFile,I); Read(RecipeFile,Recipe);
                   GotoXY(X,Y); Write(Name);
                   If I = 14 then
                   begin
                       X := 45; Y := 4;
                   end;
                   I := I + 1; Y := Y + 1;
               Until (I = 29) or (EOF(RecipeFile));
               HighestRecord := I-1;
           end;
           Close(RecipeFile);
           Option := 40;
           Repeat
               WriteStatusLine('(1-30) to DISPLAY.    (0) for MENU.');
               Read(Option);
           Until Option in [0..30];
           If Option = 0 then Exit;
           DisplayRecipe(Option - 1);
       end;
   procedure EnterRecipe;
       var
           C,D,K : Integer;
       begin
           ClrScr;
           DrawMask;
           DrawStatusLine;
           WriteStatusLine('Enter NAME of Recipe.');
           With Recipe Do
           begin
               GotoXY(14,1); Write('??????????????????????????????????');
               GotoXY(14,1); Read(Name); GotoXY(14,1); ClrEol;
               Write(Name); C := 14; D := 2;
               WriteStatusLine('Enter INGREDIENTS.');
               For K := 1 to 15 Do
               begin
                   GotoXY(C,D); Write('????????????????????'); GotoXY(C,D);
                   Read(Ingredient[K]); GotoXY(C,D); ClrEol;
                   Write(Ingredient[K]); C := C + 22;
                   If C = 80 then
                   begin
                       C := 14; D := D + 1;
                   end;
               end;
               WriteStatusLine('Enter DIRECTIONS.  Enter RETURN For Blank Lines.');
               D := 8;
               For K := 1 to 13 Do
               begin
                   GotoXY(1,D); Read(Direction[K]);
                   D := D + 1;
               end;
               Repeat
                   WriteStatusLine('(A)ccept   (C)hange   (D)elete');
                   Read(Kbd,Choice);
                   Case Choice of
                       'A','a' : Accept;
                       'C','c' : Change;
                       'D','d' : Exit;
                   end;
               Until (Choice in ['A','a','C','c','D','d']) and (not Changed);
           end;
       end;
begin
Repeat
   Repeat
       Option := 20;
       ClrScr; DrawStatusLine;
       GotoXY(32,2);  Write('* RECIPE FILE *');
       GotoXY(30,3);  Write('===================');
       GotoXY(32,5);  Write(' 1) Beef');
       GotoXY(32,6);  Write(' 2) Pork');
       GotoXY(32,7);  Write(' 3) Lamb');
       GotoXY(32,8);  Write(' 4) Poultry');
       GotoXY(32,9);  Write(' 5) Seafood');
       GotoXY(32,10); Write(' 6) Meat Less');
       GotoXY(32,11); Write(' 7) Vegetables');
       GotoXY(32,12); Write(' 8) Breads');
       GotoXY(32,13); Write(' 9) Salads');
       GotoXY(32,14); Write('10) Appetizers');
       GotoXY(32,15); Write('11) Cakes');
       GotoXY(32,16); Write('12) Cookies');
       GotoXY(32,17); Write('13) Pies');
       GotoXY(32,18); Write('14) Sauces');
       GotoXY(32,19); Write('15) Drinks');
       WriteStatusLine('Choose Option (1-15)     (0) to EXIT to CP/M');
       Read(Option);
   Until Option in [0..15];
       Case Option of
           0 : begin
                   ClrScr; Halt;
               end;
           1 : begin
                   CurrentType := 'BEEF RECIPES'; CurrentFile := 'BEEF.DTA';
               end;
           2 : begin
                   CurrentType := 'PORK RECIPES'; CurrentFile := 'PORK.DTA';
               end;
           3 : begin
                   CurrentType := 'LAMB RECIPES'; CurrentFile := 'LAMB.DTA';
               end;
           4 : begin
                   CurrentType := 'POULTRY RECIPES'; CurrentFile := 'POULTRY.DTA';
               end;
           5 : begin
                   CurrentType := 'SEAFOOD RECIPES'; CurrentFile := 'SEAFOOD.DTA';
               end;
           6 : begin
                   CurrentType := 'MEATLESS RECIPES'; CurrentFile := 'MEATLESS.DTA';
               end;
           7 : begin
                   CurrentType := 'VEGETABLE RECIPES'; CurrentFile := 'VEGIES.DTA';
               end;
           8 : begin
                   CurrentType := 'BREAD RECIPES'; CurrentFile := 'BREAD.DTA';
               end;
           9 : begin
                   CurrentType := 'SALAD RECIPES'; CurrentFile := 'SALAD.DTA';
               end;
          10 : begin
                   CurrentType := 'APPETIZER RECIPES'; CurrentFile := 'APETIZER.DTA';
               end;
          11 : begin
                   CurrentType := 'CAKE RECIPES'; CurrentFile := 'CAKE.DTA';
               end;
          12 : begin
                   CurrentType := 'COOKIE RECIPES'; CurrentFile := 'COOKIE.DTA';
               end;
          13 : begin
                   CurrentType := 'PIE RECIPES'; CurrentFile := 'PIE.DTA';
               end;
          14 : begin
                   CurrentType := 'SAUCE RECIPES'; CurrentFile := 'SAUCE.DTA';
               end;
          15 : begin
                   CurrentType := 'DRINK RECIPES'; CurrentFile := 'DRINK.DTA';
               end;
       end;
       Repeat
           WriteStatusLine('(E)nter New Recipe      (L)ist Recipes In File      e(X)it To CP/M');
           Read(Kbd,Choice);
       Until Choice in ['E','e','L','l','X','x'];
       Case Choice of
           'E','e' : EnterRecipe;
           'L','l' : ListNames;
           'X','x' : begin
                         ClrScr;
                         Halt;
                     end;
       end;
Until (Choice = 'X') or (Choice = 'x');
end.


You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.