PROGRAM RECIPE;
(*
**  PROGRAM TITLE       THE RECIPE SYSTEM
**                      Version PAS-1.2 translated from
**                      the BASIC version into Pascal.
**
**  WRITTEN BY:         Ray Penley
**  DATE WRITTEN:       23 FEB 1980 / last modified: 28 FEB 80
**  WRITTEN FOR:        Computer hobbyists
**
**  PROGRAM SUMMARY:
**
**  The recipe system stores recipes and retrives them
**  by means of a numeric key that represents the foods
**  used in the meal.  Foods are divided into four
**  categories according to their nutritional value.
**
**  INPUT AND OUTPUT FILES:
**      RCPDAT.XXX and RCPDAT.YYY
**                 - the DATA and the backup files
**      RECIPE.MST - the statistics file
**      DUMMY.$$$  - see Procedure InputRecipe for use.
**
**  ORIGINAL PROGRAM:
**      T.G.LEWIS, 'THE MIND APPLIANCE'
**      HAYDEN BOOK COMPANY
**)
CONST
 str_len = 73;         (* max length of all strings + one *)
 EOS     = '|';        (* End of String marker *)
 Master  = 'RECIPE.MST';
 Tab20   = 20 ;
 Tab15   = 15 ;
 on      = true;
 off     = false;

(* !!!!! IMPLEMENTATION DEPENDENCY !!!!! *)
  (*****   PASCAL/Z ver 2.0   *****)
         INPUT   = 0;

TYPE
 string   = packed array[1..str_len] of char;
 string2  = packed array[1..2] of char;
 string14 = packed array[1..14] of char;
 datatype = record
                MR,            (* MaxRecords   *)
                CR : integer;  (* Curr_Rcds    *)
                F1,            (* current_ID   *)
                F2,            (* backup_ID    *)
                date : string14(* last_update  *)
            end;
VAR
 a_RAY         : packed array[1..5] of string;
 data          :datatype;
 Bell,
 command       :char;
 Last_update   :string14;
 Curr_Rcds,    (* No. of current active records *)
 Hash,         (* Computed Index value of Recipe *)
 Last,
 MaxRecords,   (* Maximum records allowed *)
 TTY           (* width of terminal/CRT *)
               :integer;
 End_of_File,          (* End of File flag *)
 End_of_Text,          (* End of Text flag *)
 adding_recipies,      (* flag = true when adding recipies *)
 switch, error,
 done, yflag   : boolean;

       (* FID. File Identifier *)
 current_ID,                   (* Current file ID *)
 backup_ID     :string14;      (* Back up file ID *)

       (* FCB. File descriptors *)
 fa, fb        :TEXT;
 stats         :FILE of datatype;


(*----------------------------------------------*
*            INPUT/OUTPUT ROUTINES             *
*----------------------------------------------*)


(*----------------------------------------------*)
(*                DISK I/O                      *)
(*----------------------------------------------*)


Procedure OPEN_MASTER;
begin
 (* OPEN file RECIPE.MST for READ assign stats *)
         RESET(master, stats);
 READ(stats, data );
 with data do begin
   MaxRecords := MR;
   Curr_Rcds  := CR;
   current_ID  := F1;
   backup_ID   := F2;
   last_update := date
   end(* with *)
end;

Procedure UPDATE_MASTER;
begin
 (* OPEN file RECIPE.MST for WRITE assign stats *)
         REWRITE(master, stats);
 with data do begin
   MR := MaxRecords;
   CR := Curr_Rcds;
   F1 := current_ID ;
   F2 := backup_ID ;
   date := last_update
   end(* with *);
 WRITE(stats, data )
end;

Procedure GETLINE((* VAR fx : TEXT; *)
                    VAR INBUFF : string );
(**
Returns:
       End_of_Text = true if attempt is made to exceed
                   the input buffer length.
       End_of_File = true if EOF
       INBUFF    = input string
***)
VAR
CH   : CHAR;
ix, length : integer;
begin
 length := 0;
 End_of_Text := FALSE;
 WHILE NOT EOF(fa) AND (CH <> EOS) DO
   begin
   If length < str_len then
     begin
     READ(fa, CH );
     length := length +1;
     INBUFF [length] := CH
     end(* If *)
   ELSE        (***   error   ***)
     begin
     error := true;
     End_of_Text := TRUE
     end(* else *)
   end(* WHILE *);
   If length >= last then
     last:=length
   Else
     REPEAT
       INBUFF[ last ] := EOS;
       last := last -1
     UNTIL last=length;
       (*** !!! SET FLAG !!! ***)
 End_of_File := EOF(fa);
end(*---of GetLine---*);

Procedure PUTLINE((* VAR fx : TEXT; *)
                    VAR this :string );
VAR
 CH  : char;
 pos : integer;
begin
 pos := 0;
 REPEAT
   pos := pos +1;
   CH := this[ pos ];
   If CH <> EOS then Write(fb, CH)
 UNTIL (CH = EOS) OR (pos = str_len);
 Write(fb, EOS ) (* Mark the End of String *)
end(*---of PUTLINE---*);

Procedure PUT_RECORD((* VAR fx : TEXT; *)
                       VAR Index : integer );
VAR
 jx : integer;
begin
 Writeln(fb, Index:5);
 For jx:=1 to 5 do
   PUTLINE((* fb, *) a_RAY[jx] );
end(*---of PUT_RECORD---*);

Procedure GET_RECORD((* VAR fx : TEXT; *)
                       VAR Index : integer );
VAR
 JJ : integer;
begin
 READLN (fa, Index);
 FOR JJ := 1 to 5 DO
   GETLINE((* fa, *) a_RAY[JJ] );
end(*---of GET_RECORD---*);

(*----------------------------------------------*)
(*              CONSOLE I/O                     *)
(*----------------------------------------------*)

Procedure PRINT((* VAR fx : TEXT; *)
                  VAR this : string );
(*      Print the string 'this' until EOS       *)
VAR
 CH : CHAR;
 pos : integer;
begin
 pos := 0;
 REPEAT
   pos := pos +1;
   CH := this[ pos ];
   If CH <> EOS then Write(CH)
 UNTIL (CH = EOS) OR (pos = str_len);
 Writeln
end(*---of PRINT---*);

Procedure SCAN((* VAR fx : TEXT; *)
                VAR INBUFF : String ;
                     count : integer );
(*      SCAN Version 1.1                *
Enter with:
       count = maximum # chars allowed.
Returns:
       INBUFF = input string
       EOS    = End of string marker
Flags:
       error  = false - good input
              = true if buffer length exceeded
                     If invalid ASCII char detected.

       Valid Alphanumeric chars are:
       between the space - CHR(32) to the tilde - CHR(126)
GLOBAL
  str_len = << default for string length >>
  EOS   = '|';
  error  : boolean
  string  : packed array[1..str_len] of char
*)
VAR
 InChar : char;
 length : integer;
begin
 error := false;
 For length:=1 to str_len do INBUFF[ length ]:= EOS;
 length := 0;
 REPEAT
   If length < count then(* get valid inputs *)
     begin
     READ( InChar );
     If InChar IN [' ' .. '~'] then
       begin (* Increment length and store InChar *)
       length := length +1;
       INBUFF[length] := InChar
       end(* if *)
     ELSE
       begin
       Writeln(' Alphanumerics only -');
       error:=TRUE
       end(* else *)
     end(* If *)
   ELSE        (*   ERROR   *)
     begin (* RESET EndOfLine (EOLN) *)
     READLN(INBUFF[count]);
     Writeln('Maximum of', count:4, ' characters please!');
     error:=TRUE
     end(* ELSE *)
 UNTIL EOLN(INPUT) OR error;
end(*---of SCAN11---*);

(*----------------------------------------------*
*              UTILITY ROUTINES                *
*----------------------------------------------*)


Procedure QUIRY;
(*      YES/NO INPUT MODULE
Returns:
       yflag   =TRUE FOR ''Y' or 'y' INPUT
               =FALSE FOR 'N' or 'n' INPUT
GLOBAL
       yflag : boolean;
*)
VAR
 Ans : char;
 error : boolean;
begin
 error := true;
 yflag := false;
 REPEAT
   error := false;
   READ(Ans);
   If (Ans = 'Y') OR (Ans = 'y') then
     yflag := true
   Else
     If (Ans <> 'N') AND (Ans <> 'n') then
       begin
       Writeln(BELL, 'Please answer ''Y'' or ''N'' ');
       error := true
       end
 Until NOT error
end(*---of QUIRY---*);

Procedure CLEAR;
(* Device dependent procedure   *)
begin
 Write( CHR(26) );
end;

Procedure SKIP(L1 : integer);
VAR ix : integer;
begin
 FOR ix:=1 to L1 do Writeln;
end;

Procedure PAUSE;
VAR dummy : char;
begin
 skip(4);
 Write('Type return to continue:');
 READ(dummy);
end;

Procedure BREAK;
begin
 CLEAR;
 SKIP(5);
end;

Procedure Pstring(picture : string2; count : integer );
VAR ix : integer;
begin
 FOR ix:=1 to count DO Write( picture );
 Writeln;
end(*---of Pstring---*);

Procedure ShowRecipe;
VAR JJ : integer;
begin
 FOR JJ := 1 to 5 DO
   PRINT(a_RAY[JJ]) ;
 Writeln
end(*--of ShowRecipe--*);

Procedure Display_One(VAR Index : integer);
begin
 Writeln;
 Writeln( 'Recipe #', Index:5 );
 Writeln;
 Pstring( '- ', 20);
 Writeln;
 ShowRecipe;
 skip(4)
end;

(*----------------------------------------------*
*                 ADD MODULE                   *
*----------------------------------------------*)

Procedure InputFeatures(VAR I : integer);
(******************************************
*       Input Features of Recipe          *
*******************************************)
(*
RETURNS:
 Hash value computed for various choices
**)
CONST
 Msg1    = 'None of these' ;
VAR
  F, D, V, P :integer;

       Function QUIRY(X2 : integer) : integer;
       VAR ix : integer;
       begin
         REPEAT
           Writeln;
           Write('Enter Choice (1 to', X2:2, ') ');
           READ(ix);
         UNTIL (ix>=1) AND (ix<=X2) ;
         QUIRY := ix;
       end;
begin
 Writeln;
 Writeln( ' Enter number of choice :');
 Writeln;
 Writeln( ' ':Tab15, 'Fibre Foods' );
 Writeln;
 Writeln( ' ':Tab15, '1.  Bread (flour)     2.  Oats' );
 Writeln( ' ':Tab15, '3.  Rice              4.  Corn' );
 Writeln( ' ':Tab15, '5.  Macaroni          6.  Noodles' );
 Writeln( ' ':Tab15, '7.  Spaghetti         8.  ', Msg1 );
 F := quiry(8);
 Writeln;
 Writeln( ' ':Tab15, 'Protein' );
 Writeln;
 Writeln( ' ':Tab15, '1.  Beef              2.  Poultry' );
 Writeln( ' ':Tab15, '3.  Fish              4.  Eggs' );
 Writeln( ' ':Tab15, '5.  Beans             6.  Nuts' );
 Writeln( ' ':Tab15, '7.  ', Msg1 );
 P := quiry(7);
 BREAK;
 Writeln;
 Writeln( ' ':Tab15, 'Dairy' );
 Writeln;
 Writeln( ' ':Tab15, '1.  Milk                2.  Cheese' );
 Writeln( ' ':Tab15, '3.  Cottage Cheese      4.  Cream' );
 Writeln( ' ':Tab15, '5.  Sour Cream          6.  ', Msg1 );
 D := quiry(6);
 Writeln;
 Writeln( ' ':Tab15, 'Fruits and Vegetables' );
 Writeln;
 Writeln( ' ':Tab15, '1.  Citrus              2.  Melon' );
 Writeln( ' ':Tab15, '3.  Juices              4.  Greens' );
 Writeln( ' ':Tab15, '5.  Yellows & Reds' );
 Writeln( ' ':Tab15, '6.  ', Msg1 );
 V := quiry(6);

  (******************************************
  *  Compute the index value by assigning   *
  *  a weight to each digit in the set.     *
  *******************************************)

       I := 252*F + 36*P + 6*D + V -295
end;


Procedure InputRecipe;

LABEL 2399; (*---EXIT---*)

VAR
 state : (absent, done, adding) ;
 ix, jx : integer;
 temp   : string14;
 Line   : string;

       Procedure Correct;
       begin
       REPEAT
         BREAK;
         Write(bell);
         Writeln(' ':(TTY DIV 2) -10, 'HERE IS YOUR RECIPE');
         Writeln;
         ShowRecipe;
         Writeln;
         Writeln('Are there any corrections to be made ');
         QUIRY;
         If yflag then
           begin
           BREAK;
           Writeln('Enter <cr> return if correct or Reenter the line');
           Writeln;
           For ix:=1 to 5 do
             begin
             PRINT(a_RAY[ix]);
             SCAN(Line, str_len -1);
             If Line[1] <> ' ' then a_RAY[ix] := Line
             end
           end(* If *)
       Until yflag=false;
       end(*---of Correct---*);

       Procedure QUEST;
       begin
         Pause;
         BREAK;
         Write('Do you want to ADD recipies? ' );
         QUIRY;
         CLEAR;
       end;

begin(*---InputRecipe---*)
 QUEST;
 If yflag=false then (* EXIT *) goto 2399;
 adding_recipies := true ;
 state := adding ;
 (* OPEN file backup_ID for WRITE assign fb *)
       REWRITE(backup_ID, fb);

 (* OPEN file current_ID for READ assign fa *)
       RESET(current_ID, fa);

 If NOT EOF(fa) then
   begin(* COPY current to back_up *)
   ix := 0 ;
   While ix < Curr_Rcds do
     begin
     ix := ix +1;
     GET_RECORD((* fa, *) HASH);
     PUT_RECORD((* fb, *) HASH);
     end(* while *)
   end(* IF *);

(*---Input/Enter additional recipies until done---*)
(*---or curr_records > Max_Records allowed     ---*)

 REPEAT
 If Curr_Rcds > MaxRecords then
   state := done
 Else(* we can add more date *)
   begin
     Writeln( 'Identify Recipe with features. First ');
     InputFeatures(HASH);
     BREAK;
     Writeln( 'Now Enter 5 lines of the recipe');
     Writeln;
     For jx := 1 to 5 DO
       begin
       Write('>');
       SCAN( a_RAY[jx], str_len -1 );
       end;(* For *)
     Correct(* if required *);
     Curr_Rcds := Curr_Rcds +1;
     PUT_RECORD((* fb, *) HASH);
     QUEST;
     If yflag=false then state := done;
   end;(* else *)
 UNTIL state<>adding;

 (*---------------------------------------*
  *         ***   trick   ***             *
  *  close previous file ID assigned      *
  *  FCB fb and fix CP/M directory entry  *
  *---------------------------------------*)

       REWRITE('DUMMY.$$$', fb);

 (*    SWAP file ID`s                          *)
 (*    Back Up file is now the Current file    *)
 temp := backup_ID;
 backup_ID := current_ID;
 current_ID := temp;

 UPDATE_MASTER;(*--status file--*)

2399: (* EXIT *);
end(*--of InputRecipe--*);


(*--------------------------------------*)
(*            DUMP/FIND MODULE          *)
(*--------------------------------------*)

Procedure File_Scan ;
(*
GLOBAL
 MaxRecords = maximum allowed records
 Curr_Rcds = # of recipes in file
*)
VAR
 state : (absent, found, searching) ;
 ix, index : integer;

       Procedure DUMP;
       (*********************************
       *  OUTPUT all Recipes from file  *
       **********************************)
       begin
         REPEAT
           If ix > Curr_Rcds then
             state := absent
           Else
             begin
               ix := ix +1;
               GET_RECORD((* fa, *) HASH);
               Display_One(HASH);
               Pause
             end(* else *)
         UNTIL state<>searching;
       end(*--of DUMP--*);

       Procedure FIND;
       (*************************************
       *       Lookup recipes from file     *
       **************************************)
       VAR
         Index : integer;
       begin
         CLEAR;
         InputFeatures(Index);
         REPEAT
           If ix > Curr_Rcds then
             state := absent
           Else
             begin
               GET_RECORD((* fa, *) HASH);
               If HASH=Index then
                 state := found
               Else
                 ix := ix +1
             end(* else *);
         Until state<>searching;
         If state=found then
           begin
           CLEAR;
           Display_One(HASH);
           end;
       end(*--of Lookup--*);

begin(*---File_Scan---*)
 Pause;
 state := absent;
 If adding_recipies then
   (* read new stats *) OPEN_MASTER;
 (* OPEN file current_ID for READ assign fa *)
         RESET(current_ID, fa);

 If NOT EOF(fa) then
   begin
   state := searching ;
   ix := 1 ;
   If Curr_rcds=0 then
     state := absent
   Else
     begin
       CASE command of
         'O', 'o':     DUMP;
         'F', 'f':     FIND
       end(* case *)
     end(* else *)
   end(* IF *);
 If state=absent then
   begin
   BREAK;
   Writeln('That''s all the Recipes on File');
   end;
 Pause;
end(*---of File_Scan---*);

(*--------------------------------------*)
(*            INITIALIZATION            *)
(*--------------------------------------*)


Procedure INIT1;
(* byte count/record = (chars/line + overhead/line) times No. of lines *)
begin
 BELL          := CHR(7) ;
 TTY           :=  72 ;
 last          := str_len ;
 MaxRecords    := 50 ;(* 360 times 50 = 18000 bytes *)
 Curr_Rcds     :=  0 ;
 Last_Update   := 'YY/MM/DD      ';
 current_ID    := 'RCPDAT.XXX    ';
 backup_ID     := 'RCPDAT.YYY    ';
 adding_recipies := false
end;

Procedure INIT2;
begin
  (* OPEN file `RECIPE.MST` for READ assign stats *)
         RESET(master, stats);

 If EOF(stats) then(* not found *)
   (* OPEN file `RECIPE.MST` for WRITE assign stats *)
         UPDATE_MASTER
 Else begin(* READ in data record *)
   READ(stats, data );
   with data do begin
     MaxRecords := MR;
     Curr_Rcds  := CR;
     current_ID := F1;
     backup_ID  := F2;
     last_update := date
     end(* with *)
   end;
 SKIP(5);
 Writeln('Last update of Recipe data file was ', last_update);
 Writeln('File currently consists of ', Curr_Rcds:4, ' Recipies');
 Writeln;
 Write('Please enter todays date <YY/MM/DD>  ');
 READLN(last_update)
end;

(*----------------------------------------------*
*              MAIN PROGRAM                    *
*----------------------------------------------*)

BEGIN
 INIT1;
 CLEAR;
 Pstring( '**', (TTY DIV 2));
 Writeln;
 Writeln( ' ':22, 'The Recipe System');
 Writeln;
 Pstring( '**', (TTY DIV 2));
 INIT2;
 done := false;
 WHILE NOT(done) DO
   begin
   CLEAR;
   Pstring( '**', (TTY DIV 2));
   skip(3);
   Writeln( ' ':Tab15, 'Select One of the following:');
   Writeln;
   Writeln( ' ':Tab20, 'I(nput Recipes');
   Writeln( ' ':Tab20, 'O(utput all Recipes');
   Writeln( ' ':Tab20, 'F(ind a Recipe');
   Writeln( ' ':Tab20, 'S(top');
   switch := on;
   WHILE switch(* is on *
) do
     begin
     switch := off;
     Writeln;
     Write(' ':(Tab15), 'Enter choice   ' );
     READ( command );
       CASE command of
         'I', 'i':     InputRecipe;
         'O', 'o',
         'F', 'f':     File_Scan;
         'S', 's':     done := true;
        ELSE:          begin
                       Write(BELL);
                       switch := on
                       end
       end(* case *)
     end(* while switch is on *)
   end(* while not done *)
end(*---of Program Recipe---*).

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.