home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / turbopas / recipe.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-07-13  |  13.1 KB  |  375 lines
  1.     {$C-}
  2.     const
  3.         Changed : Boolean = False;
  4.        DiskFull : Boolean = False;
  5.     type
  6.         Entry = Record
  7.                           Name : String[34];
  8.                     Ingredient : Array[1..15] of String[20];
  9.                      Direction : Array[1..13] of String[79];
  10.                 end;
  11.         Str12 = String[12];
  12.         Str80 = String[80];
  13.     var
  14.          RecipeFile : File of Entry;
  15.              Recipe : Entry;
  16.          TestString : Str80;
  17.         CurrentFile : Str12;
  18.         CurrentType : String[30];
  19.              Choice : Char;
  20.            Continue : Char;
  21.              Option : Integer;
  22.       HighestRecord : Integer;
  23.     function Exist(FileName : Str12) : Boolean;
  24.         var
  25.             Fil : File;
  26.         begin
  27.             Assign(Fil, FileName);
  28.             {$I-} Reset(Fil) {$I+};
  29.             Exist := (IOresult = 0)
  30.         end;
  31.     procedure DrawStatusLine;
  32.         begin
  33.             GotoXY(1,21); Write(' ==============================================================================');
  34.             GotoXY(1,23); Write(' ==============================================================================');
  35.         end;
  36.     procedure WriteStatusLine(Status : Str80);
  37.         var
  38.             Margin : Integer;
  39.         begin
  40.             Margin := ((80-length(Status)) div 2);
  41.             GotoXY(1,22); ClrEol;
  42.             GotoXY(Margin,22); Write(^G,Status + '  ');
  43.         end;
  44.     procedure DrawMask;
  45.         begin
  46.             GotoXY(8,1); Write('NAME :');
  47.             GotoXY(1,2); Write('INGREDIENTS :');
  48.             GotoXY(2,7); Write('DIRECTIONS :');
  49.         end;
  50.     procedure DrawScreen;
  51.         var
  52.            A,B,J  : Integer;
  53.         begin
  54.             With Recipe do
  55.             begin
  56.                 GotoXY(14,1);ClrEol;Write(Name);
  57.                 A := 14; B := 2;
  58.                 For J := 1 to 15 Do
  59.                 begin
  60.                     GotoXY(A,B);Write('                    '); GotoXY(A,B);
  61.                     Write(Ingredient[J]); A := A + 22;
  62.                     If A = 80 then
  63.                     begin
  64.                         A := 14; B := B + 1;
  65.                     end;
  66.                 end;
  67.                 B := 8;
  68.                 For J := 1 to 13 Do
  69.                 begin
  70.                     GotoXY(1,B); ClrEol; Write(Direction[J]);
  71.                     B := B + 1;
  72.                 end;
  73.             end;
  74.         end;
  75.     procedure Accept;
  76.         begin
  77.             Assign(RecipeFile,CurrentFile);
  78.             If not Exist(CurrentFile) then Rewrite(RecipeFile)
  79.             else Reset(RecipeFile);
  80.             With Recipe Do
  81.             begin
  82.                 {$I-} Seek(RecipeFile, FileSize(RecipeFile)) {$I+};
  83.                 DiskFull := (IOresult = $F0);
  84.                 If DiskFull then
  85.                 begin
  86.                     WriteStatusLine('DISK FULL !!!  Erase Unnecessary Files.  (ANY KEY) to QUIT.');
  87.                     Read(Continue); Halt;
  88.                 end;
  89.                 Write(RecipeFile,Recipe);
  90.                 Flush(RecipeFile);
  91.                 Close(RecipeFile);
  92.             end;
  93.             Changed := False;
  94.         end;
  95.     procedure Change;
  96.         var
  97.             X,Y,I : Integer;
  98.         begin
  99.             With Recipe Do
  100.             begin
  101.                 GotoXY(14,1); Read(TestString);
  102.                 If TestString <> '' then
  103.                 begin
  104.                     Changed := True;
  105.                     Name := TestString;
  106.                     DrawScreen;
  107.                 end;
  108.                 X := 14; Y := 2;
  109.                 For I := 1 to 15 Do
  110.                 begin
  111.                     GotoXY(X,Y); Read(TestString);
  112.                     If TestString <> '' then
  113.                     begin
  114.                         Changed := True;
  115.                         Ingredient[I] := TestString;
  116.                         DrawScreen;
  117.                     end;
  118.                     X := X + 22;
  119.                     If X = 80 then
  120.                     begin
  121.                         X := 14; Y := Y + 1;
  122.                     end;
  123.                 end;
  124.                 Y := 8;
  125.                 For I := 1 to 13 Do
  126.                 begin
  127.                     GotoXY(1,Y); Read(TestString);
  128.                     If TestString <> '' then
  129.                     begin
  130.                         Changed := True;
  131.                         Direction[I] := TestString;
  132.                         DrawScreen;
  133.                     end;
  134.                     Y := Y + 1;
  135.                 end;
  136.             end;
  137.         end;
  138.     procedure FindRecipe(Rec : Integer);
  139.         begin
  140.             Assign(RecipeFile,CurrentFile);
  141.             Reset(RecipeFile);
  142.             With Recipe Do
  143.             begin
  144.                 Seek(RecipeFile,Rec);
  145.                 Read(RecipeFile,Recipe);
  146.                 Close(RecipeFile);
  147.             end;
  148.         end;
  149.     procedure PrintRecipe;
  150.         var
  151.             A,B,J : Integer;
  152.            Blanks : String[25];
  153.         begin
  154.             Blanks := '                         ';
  155.             WriteStatusLine('Printer ON Then Press (RETURN)');
  156.             Read(Continue);
  157.             With Recipe Do
  158.             begin
  159.                 Writeln(Lst,'NAME : ',Name); Writeln(Lst);
  160.                 Writeln(Lst,'INGREDIENTS :');
  161.                 For J := 1 to 15 Do
  162.                 begin
  163.                     Write(Lst,Ingredient[J] + Copy(Blanks,1,(25 - length(Ingredient[J]))));
  164.                     If J mod 3 = 0 then
  165.                         Write(Lst,^M^J);
  166.                 end;
  167.                 Writeln(Lst);
  168.                 Writeln(Lst,'DIRECTIONS :');
  169.                 For J := 1 to 13 Do
  170.                 begin
  171.                     Writeln(Lst,Direction[J]);
  172.                 end;
  173.                 Writeln(Lst,#12);
  174.             end;
  175.         end;
  176.     procedure DisplayRecipe(Number : Integer);
  177.         begin
  178.             If Number > HighestRecord then
  179.             begin
  180.                 WriteStatusLine('That Recipe Does NOT Exist.  (ANY KEY) to Continue.');
  181.                 Read(Continue); Exit;
  182.             end;
  183.             With Recipe Do
  184.             begin
  185.                 FindRecipe(Number);
  186.                 ClrScr;
  187.                 DrawMask;
  188.                 DrawStatusLine;
  189.                 DrawScreen;
  190.                 WriteStatusLine('(P)rint      (ANY KEY) for MENU');
  191.                 Read(Choice);
  192.                 If (Choice = 'P') or (Choice = 'p') then
  193.                     PrintRecipe
  194.                 else
  195.                     Exit;
  196.             end;
  197.         end;
  198.     procedure ListNames;
  199.         var
  200.             I,X,Y : Integer;
  201.         begin
  202.             ClrScr; DrawStatusLine;
  203.             GotoXY(((80 - length(CurrentType)) div 2),3);
  204.             Write(CurrentType); X := 1; Y := 5;
  205.             For I := 1 to 30 Do
  206.             begin
  207.                 GotoXY(X,Y); Write(I:2,': ');
  208.                 If I = 15 then
  209.                 begin
  210.                     X := 41; Y := 4;
  211.                 end;
  212.                 Y := Y + 1;
  213.             end;
  214.             If not Exist(CurrentFile) then
  215.             begin
  216.                 WriteStatusLine('That File Does NOT Exist.  (ANY KEY) to Continue.');
  217.                 Read(Kbd,Continue); Exit;
  218.             end;
  219.             Assign(RecipeFile,CurrentFile);
  220.             Reset(RecipeFile);
  221.             I := 0; X := 5; Y := 5;
  222.             With Recipe Do
  223.             begin
  224.                 Repeat
  225.                     Seek(RecipeFile,I); Read(RecipeFile,Recipe);
  226.                     GotoXY(X,Y); Write(Name);
  227.                     If I = 14 then
  228.                     begin
  229.                         X := 45; Y := 4;
  230.                     end;
  231.                     I := I + 1; Y := Y + 1;
  232.                 Until (I = 29) or (EOF(RecipeFile));
  233.                 HighestRecord := I-1;
  234.             end;
  235.             Close(RecipeFile);
  236.             Option := 40;
  237.             Repeat
  238.                 WriteStatusLine('(1-30) to DISPLAY.    (0) for MENU.');
  239.                 Read(Option);
  240.             Until Option in [0..30];
  241.             If Option = 0 then Exit;
  242.             DisplayRecipe(Option - 1);
  243.         end;
  244.     procedure EnterRecipe;
  245.         var
  246.             C,D,K : Integer;
  247.         begin
  248.             ClrScr;
  249.             DrawMask;
  250.             DrawStatusLine;
  251.             WriteStatusLine('Enter NAME of Recipe.');
  252.             With Recipe Do
  253.             begin
  254.                 GotoXY(14,1); Write('??????????????????????????????????');
  255.                 GotoXY(14,1); Read(Name); GotoXY(14,1); ClrEol;
  256.                 Write(Name); C := 14; D := 2;
  257.                 WriteStatusLine('Enter INGREDIENTS.');
  258.                 For K := 1 to 15 Do
  259.                 begin
  260.                     GotoXY(C,D); Write('????????????????????'); GotoXY(C,D);
  261.                     Read(Ingredient[K]); GotoXY(C,D); ClrEol;
  262.                     Write(Ingredient[K]); C := C + 22;
  263.                     If C = 80 then
  264.                     begin
  265.                         C := 14; D := D + 1;
  266.                     end;
  267.                 end;
  268.                 WriteStatusLine('Enter DIRECTIONS.  Enter RETURN For Blank Lines.');
  269.                 D := 8;
  270.                 For K := 1 to 13 Do
  271.                 begin
  272.                     GotoXY(1,D); Read(Direction[K]);
  273.                     D := D + 1;
  274.                 end;
  275.                 Repeat
  276.                     WriteStatusLine('(A)ccept   (C)hange   (D)elete');
  277.                     Read(Kbd,Choice);
  278.                     Case Choice of
  279.                         'A','a' : Accept;
  280.                         'C','c' : Change;
  281.                         'D','d' : Exit;
  282.                     end;
  283.                 Until (Choice in ['A','a','C','c','D','d']) and (not Changed);
  284.             end;
  285.         end;
  286. begin
  287. Repeat
  288.     Repeat
  289.         Option := 20;
  290.         ClrScr; DrawStatusLine;
  291.         GotoXY(32,2);  Write('* RECIPE FILE *');
  292.         GotoXY(30,3);  Write('===================');
  293.         GotoXY(32,5);  Write(' 1) Beef');
  294.         GotoXY(32,6);  Write(' 2) Pork');
  295.         GotoXY(32,7);  Write(' 3) Lamb');
  296.         GotoXY(32,8);  Write(' 4) Poultry');
  297.         GotoXY(32,9);  Write(' 5) Seafood');
  298.         GotoXY(32,10); Write(' 6) Meat Less');
  299.         GotoXY(32,11); Write(' 7) Vegetables');
  300.         GotoXY(32,12); Write(' 8) Breads');
  301.         GotoXY(32,13); Write(' 9) Salads');
  302.         GotoXY(32,14); Write('10) Appetizers');
  303.         GotoXY(32,15); Write('11) Cakes');
  304.         GotoXY(32,16); Write('12) Cookies');
  305.         GotoXY(32,17); Write('13) Pies');
  306.         GotoXY(32,18); Write('14) Sauces');
  307.         GotoXY(32,19); Write('15) Drinks');
  308.         WriteStatusLine('Choose Option (1-15)     (0) to EXIT to CP/M');
  309.         Read(Option);
  310.     Until Option in [0..15];
  311.         Case Option of
  312.             0 : begin
  313.                     ClrScr; Halt;
  314.                 end;
  315.             1 : begin
  316.                     CurrentType := 'BEEF RECIPES'; CurrentFile := 'BEEF.DTA';
  317.                 end;
  318.             2 : begin
  319.                     CurrentType := 'PORK RECIPES'; CurrentFile := 'PORK.DTA';
  320.                 end;
  321.             3 : begin
  322.                     CurrentType := 'LAMB RECIPES'; CurrentFile := 'LAMB.DTA';
  323.                 end;
  324.             4 : begin
  325.                     CurrentType := 'POULTRY RECIPES'; CurrentFile := 'POULTRY.DTA';
  326.                 end;
  327.             5 : begin
  328.                     CurrentType := 'SEAFOOD RECIPES'; CurrentFile := 'SEAFOOD.DTA';
  329.                 end;
  330.             6 : begin
  331.                     CurrentType := 'MEATLESS RECIPES'; CurrentFile := 'MEATLESS.DTA';
  332.                 end;
  333.             7 : begin
  334.                     CurrentType := 'VEGETABLE RECIPES'; CurrentFile := 'VEGIES.DTA';
  335.                 end;
  336.             8 : begin
  337.                     CurrentType := 'BREAD RECIPES'; CurrentFile := 'BREAD.DTA';
  338.                 end;
  339.             9 : begin
  340.                     CurrentType := 'SALAD RECIPES'; CurrentFile := 'SALAD.DTA';
  341.                 end;
  342.            10 : begin
  343.                     CurrentType := 'APPETIZER RECIPES'; CurrentFile := 'APETIZER.DTA';
  344.                 end;
  345.            11 : begin
  346.                     CurrentType := 'CAKE RECIPES'; CurrentFile := 'CAKE.DTA';
  347.                 end;
  348.            12 : begin
  349.                     CurrentType := 'COOKIE RECIPES'; CurrentFile := 'COOKIE.DTA';
  350.                 end;
  351.            13 : begin
  352.                     CurrentType := 'PIE RECIPES'; CurrentFile := 'PIE.DTA';
  353.                 end;
  354.            14 : begin
  355.                     CurrentType := 'SAUCE RECIPES'; CurrentFile := 'SAUCE.DTA';
  356.                 end;
  357.            15 : begin
  358.                     CurrentType := 'DRINK RECIPES'; CurrentFile := 'DRINK.DTA';
  359.                 end;
  360.         end;
  361.         Repeat
  362.             WriteStatusLine('(E)nter New Recipe      (L)ist Recipes In File      e(X)it To CP/M');
  363.             Read(Kbd,Choice);
  364.         Until Choice in ['E','e','L','l','X','x'];
  365.         Case Choice of
  366.             'E','e' : EnterRecipe;
  367.             'L','l' : ListNames;
  368.             'X','x' : begin
  369.                           ClrScr;
  370.                           Halt;
  371.                       end;
  372.         end;
  373. Until (Choice = 'X') or (Choice = 'x');
  374. end.
  375.