home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol024 / recipe.pas < prev    next >
Pascal/Delphi Source File  |  1984-04-29  |  20KB  |  793 lines
  1. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  2. **  PROGRAM TITLE    THE RECIPE SYSTEM
  3. **
  4. **  Translated by:    Raymond E. Penley from the BASIC
  5. **            version into Pascal.
  6. **
  7. **  DATE WRITTEN:    23 FEB 1980
  8. **
  9. **  WRITTEN FOR:    Computer hobbyists
  10. **
  11. **  PROGRAM SUMMARY:
  12. **
  13. **  The recipe system stores recipes and retrives recipies
  14. **  by means of a numeric key that represents the foods
  15. **  used in the meal.  Foods are divided into four
  16. **  categories according to their nutritional value.
  17. **  For more comments see the original program.
  18. **
  19. **  INPUT AND OUTPUT FILES:
  20. **    RCPDAT.XXX and RCPDAT.YYY
  21. **           - the DATA and the backup files
  22. **    RCPDAT.MST - the statistics file
  23. **
  24. **  MODIFICATION RECORD:
  25. **    28 Feb 80    -
  26. **     2 Jun 80    -Rewritten for Pascal/Z v 3.0
  27. **     8 Jun 80    -Rewrote SCAN
  28. **
  29. **  ORIGINAL PROGRAM:
  30. **    T.G.LEWIS, 'THE MIND APPLIANCE'
  31. **    HAYDEN BOOK COMPANY
  32. **
  33. ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  34. PROGRAM RECIPE;
  35.  
  36. CONST
  37.   default = 80;        (* Default length for strings *)
  38.   str_len = 73;        (* Length of a recipe line plus one char *)
  39.   StrMax  = 255;    (* Max Length of strings allowed   *)
  40.   EOS      = '|';    (* End of String marker *)
  41.   Master  = 'RCPDAT.MST';
  42.   Tab20      = 20 ;
  43.   Tab15      = 15 ;
  44.   INPUT   = 0;        (*****   PASCAL/Z ver 3.n   *****)
  45.  
  46. TYPE
  47.   ALFA       = STRING 10 ;
  48.   BYTE       = 0..255;
  49.   LINE       = string default;
  50.   Mstring  = string 255 ;
  51.   DataType = record
  52.          MR,        (* MaxRecords    *)
  53.          CR : integer;    (* Curr_Rcds    *)
  54.          F1,        (* current_ID    *)
  55.          F2,        (* backup_ID    *)
  56.          date : string 14 (* last_update *)
  57.          end;
  58.   S$0   = STRING 0 ;        { zero length string }
  59.   S$255 = STRING 255 ;        { max string length  }
  60.  
  61. VAR
  62.   adding_recipies,    (* adding recipies state flag *)
  63.   comanding,        (* Command mode flag *)
  64.   done            (* Program execution flag *)
  65.         : boolean;
  66.   bell,            (* ASCII bell char *)
  67.   ch,
  68.   command    : char;
  69.   data        : datatype;
  70.   End_of_File,        (* End of File flag *)
  71.   End_of_Text        (* End of Text flag *)
  72.         : boolean;
  73.   error_flag    : BYTE;
  74.   CRT_width,    (* Width of video display *)
  75.   Curr_Rcds,    (* No. of current active records *)
  76.   Hash,        (* Computed Index value of Recipe *)
  77.   ix,        (* global indexer *)
  78.   Last,        (* length of last line read *)
  79.   MaxRecords,    (* Maximum records allowed *)
  80.   TTY_width    (* Width of teletype device *)
  81.         : integer;
  82.   Last_update    : string 14; (* date of last file update *)
  83.   matrix    : packed array[1..5] of LINE;
  84.     (*  File Identifiers <FID>  *)
  85.   current_ID,            (* Current file ID *)
  86.   backup_ID    :string 14;    (* Back up file ID *)
  87.     (* File descriptor <FCB> *)
  88.   stats        :FILE of datatype;
  89.  
  90.     {$C- [ctrl-c checking OFF]}
  91.     {$F- [floating point error checking OFF]}
  92.     {$M- [integer mult & divd checking OFF]}
  93.  
  94. (*---Required for Pascal/Z supplied string functions---*)
  95. FUNCTION LENGTH(X: S$255): INTEGER; EXTERNAL;
  96. PROCEDURE SETLENGTH(VAR X :S$0; Y :INTEGER); EXTERNAL;
  97.  
  98.  
  99.  
  100. (*----------------------------------------------*)
  101. (*          DISK I/O            *)
  102. (*----------------------------------------------*)
  103.  
  104.  
  105.  
  106. Procedure OPEN_MASTER;
  107. begin
  108.   (* OPEN file RECIPE.MST for READ assign stats *)
  109.       RESET(master, stats);
  110.   READ(stats, data );
  111.   with data do begin
  112.     MaxRecords := MR;
  113.     Curr_Rcds  := CR;
  114.     current_ID    := F1;
  115.     backup_ID    := F2;
  116.     last_update := date
  117.     end(* with *)
  118. end;
  119.  
  120. Procedure UPDATE_MASTER;
  121. begin
  122.   (* OPEN file RECIPE.MST for WRITE assign stats *)
  123.       REWRITE(master, stats);
  124.   with data do begin
  125.     MR := MaxRecords;
  126.     CR := Curr_Rcds;
  127.     F1 := current_ID ;
  128.     F2 := backup_ID ;
  129.     date := last_update
  130.     end(* with *);
  131.   WRITE(stats, data )
  132. end;
  133.  
  134. Procedure GETLINE(VAR fx : TEXT;
  135.           VAR INBUFF : LINE );
  136. { This Procedure gets a line of text from a disk file.
  137.   Returns:
  138.     End_of_Text = true if the input buffer length
  139.             exceeded.
  140.     End_of_File = true if EOF
  141.     INBUFF    = input buffer        }
  142. VAR    CH   : CHAR;
  143.     ix, length : integer;
  144. begin
  145.   length := 0;
  146.   End_of_Text := FALSE;
  147.   SETLENGTH(INBUFF,0);
  148.   WHILE NOT EOF(fx) AND (CH <> EOS) DO
  149.     begin
  150.     If length < str_len then
  151.       begin(* valid *)
  152.     READ(fx, CH );
  153.     length := SUCC(length);
  154.     APPEND(INBUFF,CH)
  155.       end(* If *)
  156.     ELSE
  157.     End_of_Text := TRUE;
  158.     end(* WHILE *);
  159.     If length >= last then
  160.       last:=length
  161.     Else
  162.       REPEAT
  163.     APPEND(INBUFF,EOS);
  164.     last := PRED(last)
  165.       UNTIL last=length;
  166.   End_of_File := EOF(fx)
  167. end(*---of GetLine---*);
  168.  
  169. Procedure PUTLINE( VAR fx   : TEXT;
  170.            VAR this : LINE );
  171. { This Procedure puts a line of text to a disk file }
  172. VAR    CH  : char;
  173.     pos : integer;
  174. begin
  175.   pos := 0;
  176.   REPEAT
  177.     pos := SUCC(pos);
  178.     CH := this[ pos ];
  179.     If CH <> EOS then Write(fx, CH)
  180.   UNTIL (CH = EOS) OR (pos = str_len);
  181.   Write(fx, EOS) (* Mark the End of String *)
  182. end(*---of PUTLINE---*);
  183.  
  184. Procedure PUT_RECORD( VAR fx    : TEXT;
  185.               VAR Index : integer );
  186. VAR    jx : integer;
  187. begin
  188.   Writeln(fx, Index:5);
  189.   For jx:=1 to 5 do
  190.     PUTLINE(fx,matrix[jx] );
  191. end(*---of PUT_RECORD---*);
  192.  
  193. Procedure GET_RECORD(VAR fx : TEXT;
  194.              VAR Index : integer );
  195. VAR    JJ : integer;
  196. begin
  197.   READLN (fx, Index);
  198.   FOR JJ := 1 to 5 DO
  199.     GETLINE(fx,matrix[JJ]);
  200. end(*---of GET_RECORD---*);
  201.  
  202.  
  203.  
  204. (*----------------------------------------------*)
  205. (*        CONSOLE I/O            *)
  206. (*----------------------------------------------*)
  207.  
  208.  
  209.  
  210. Procedure KEYIN(VAR CIX : char); EXTERNAL;
  211. (*---Single char input directly from keyboard---*)
  212.  
  213. Procedure PRINT(this : Mstring);
  214. (*    Print the string 'this' until EOS     *)
  215. VAR
  216.   CH : CHAR;
  217.   pos : integer;
  218. begin
  219.   pos := 0;
  220.   REPEAT
  221.     pos := SUCC(pos);
  222.     CH := this[ pos ];
  223.     If CH <> EOS then Write(CH)
  224.   UNTIL (CH = EOS) OR (pos = str_len);
  225.   Writeln
  226. end(*---of PRINT---*);
  227.  
  228. Procedure SCAN( VAR Arg_string    : LINE ;
  229.             count    : integer ;
  230.         VAR status    : BYTE  );
  231. (*----------------------------------------------*)
  232. (* version: 3.1 /8 JUN 80/ by R.E.Penley    *)
  233. (*----------------------------------------------*
  234. ** Scan will scan your input line and return:
  235.     STATUS:
  236.       0    -OK, valid inputs
  237.       1    -an attempt was made to exceed "count"
  238.          characters - so I truncated the string at
  239.          count chars for you.
  240.       2    -an invalid character was detected.
  241.          You figure out what to do with it!
  242.     LENGTH(arg string) = 0 means a null string input.
  243. **
  244.     Valid Alphanumeric chars are the ASCII char set
  245.     starting at the space [ CHR(32) ] and
  246.     ending at the tilde [ CHR(126) ].
  247.  *----------------------------------------------*
  248. GLOBAL  StrMax = 255;
  249.     BYTE   = 0..255;
  250.     LINE   = STRING Default;
  251.  *----------------------------------------------*)
  252. VAR    loop    : (scanning, found, notfound);
  253.     ix    : 1..StrMax;
  254. begin
  255.   { return status = 0 if no errors detected. }
  256.   status := 0;
  257.   { return status = 1 if requested length is exceeded }
  258.   If LENGTH(arg_string) > count then
  259.     begin
  260.     status := 1;
  261.     SETLENGTH(arg_string,count)
  262.     end;
  263.   loop := scanning;
  264.   ix := 1;
  265.   While (loop=scanning) do
  266.   { return status = 2 if any invalid chars found }
  267.     begin
  268.     If ix > LENGTH(arg_string) then
  269.       loop := notfound{excellent - no invalid chars}
  270.     Else
  271.       If arg_string[ix] IN [' '..'~'] then{good show - keep going}
  272.     ix := SUCC(ix)
  273.       Else
  274.     begin
  275.     loop := found{invalid char};
  276.     status := 2
  277.     end
  278.     end{while}
  279. End(*---of SCAN 3.1---*);
  280.  
  281.  
  282.  
  283. (*----------------------------------------------*)
  284. (*        UTILITY ROUTINES        *)
  285. (*----------------------------------------------*)
  286.  
  287.  
  288. Function YORN : boolean ;
  289. {
  290.     YES/NO INPUT MODULE
  291. Returns:
  292.     TRUE FOR 'Y' or 'y' INPUT
  293.     FALSE FOR 'N' or 'n' INPUT
  294. }
  295. VAR
  296.   ans : ALFA;
  297.   valid : boolean;
  298. begin
  299.   REPEAT
  300.     valid := true;
  301.     READ(ans);
  302.     CASE ans[1] of
  303.     'Y','y':    YORN := true;
  304.     'N','n':    YORN := false;
  305.     Else:    begin
  306.           valid := false;
  307.           Writeln(BELL, 'Please answer ''Y'' or ''N'' ')
  308.         end
  309.     end{case}
  310.   Until valid{response}
  311. End(*---of YORN---*);
  312.  
  313. Procedure CLEAR;
  314. (* Device dependent procedure    *)
  315. begin
  316.   Write( CHR(26) )
  317. end;
  318.  
  319. Procedure SKIP(L1 : integer);
  320. VAR ix : integer;
  321. begin
  322.   FOR ix:=1 to L1 do Writeln
  323. end;
  324.  
  325. Procedure PAUSE;
  326. CONST    sign = 'Type return to continue:';
  327. VAR    dummy : char;
  328. begin
  329.   SKIP(4);
  330.   Write(sign);
  331.   Readln(dummy)
  332. end;
  333.  
  334. Procedure BREAK;
  335. begin
  336.   CLEAR;
  337.   SKIP(5)
  338. end;
  339.  
  340. Procedure DRAW(picture : Mstring; count : integer );
  341. { Draw a picture count times }
  342. VAR ix : integer;
  343. begin
  344.   FOR ix:=1 to count DO Write( picture );
  345.   Writeln
  346. end(*---of DRAW---*);
  347.  
  348. Procedure ShowRecipe;
  349. VAR JJ : integer;
  350. begin
  351.   FOR JJ := 1 to 5 DO
  352.     PRINT(matrix[JJ]) ;
  353.   Writeln
  354. end(*--of ShowRecipe--*);
  355.  
  356. Procedure Display_One(VAR Index : integer);
  357. begin
  358.   Writeln;
  359.   Writeln( 'Recipe #', Index:5 );
  360.   Writeln;
  361.   DRAW( '- ', 20);
  362.   Writeln;
  363.   ShowRecipe;
  364.   skip(4)
  365. end(*---of Display_One---*);
  366.  
  367.  
  368. (*----------------------------------------------*
  369.  *           ADD MODULE            *
  370.  *----------------------------------------------*)
  371.  
  372.     {$C+ [ctrl-c checking ON]}
  373.  
  374. Procedure InputFeatures(VAR I : integer);
  375. (******************************************
  376.  *    Input Features of Recipe      *
  377.  ******************************************)
  378. (*
  379. RETURNS:
  380.   Hash value computed for various choices
  381. **)
  382. CONST    Msg1    = 'None of these' ;
  383. VAR    F, D, V, P :integer;
  384.  
  385.     Function QUIRY(X2 : integer) : integer;
  386.     VAR ix : integer;
  387.         cix : char;
  388.     begin
  389.       REPEAT
  390.         Writeln;
  391.         Write('Enter Choice (1 to', X2:2, ') ');
  392.         KEYIN(cix);write(cix);
  393.         ix := (ORD(cix) - ORD('0'))
  394.       UNTIL (ix>=1) AND (ix<=X2) ;
  395.       QUIRY := ix
  396.     end;
  397.  
  398. begin
  399.   Writeln;
  400.   Writeln( ' Enter number of choice :');
  401.   Writeln;
  402.   Writeln( ' ':Tab15, 'Fibre Foods' );
  403.   Writeln;
  404.   Writeln( ' ':Tab15, '1.  Bread (flour)');
  405.   Writeln( ' ':Tab15, '2.  Oats' );
  406.   Writeln( ' ':Tab15, '3.  Rice');
  407.   Writeln( ' ':Tab15, '4.  Corn' );
  408.   Writeln( ' ':Tab15, '5.  Macaroni');
  409.   Writeln( ' ':Tab15, '6.  Noodles' );
  410.   Writeln( ' ':Tab15, '7.  Spaghetti');
  411.   Writeln( ' ':Tab15, '8.  ', Msg1 );
  412.   F := QUIRY(8);
  413.   BREAK;
  414.   Writeln;
  415.   Writeln( ' ':Tab15, 'Protein' );
  416.   Writeln;
  417.   Writeln( ' ':Tab15, '1.  Beef');
  418.   Writeln( ' ':Tab15, '2.  Poultry' );
  419.   Writeln( ' ':Tab15, '3.  Fish');
  420.   Writeln( ' ':Tab15, '4.  Eggs' );
  421.   Writeln( ' ':Tab15, '5.  Beans');
  422.   Writeln( ' ':Tab15, '6.  Nuts' );
  423.   Writeln( ' ':Tab15, '7.  ', Msg1 );
  424.   P := QUIRY(7);
  425.   BREAK;
  426.   Writeln;
  427.   Writeln( ' ':Tab15, 'Dairy' );
  428.   Writeln;
  429.   Writeln( ' ':Tab15, '1.  Milk');
  430.   Writeln( ' ':Tab15, '2.  Cheese' );
  431.   Writeln( ' ':Tab15, '3.  Cottage Cheese');
  432.   Writeln( ' ':Tab15, '4.  Cream' );
  433.   Writeln( ' ':Tab15, '5.  Sour Cream');
  434.   Writeln( ' ':Tab15, '6.  ', Msg1 );
  435.   D := QUIRY(6);
  436.   BREAK;
  437.   Writeln;
  438.   Writeln( ' ':Tab15, 'Fruits and Vegetables' );
  439.   Writeln;
  440.   Writeln( ' ':Tab15, '1.  Citrus');
  441.   Writeln( ' ':Tab15, '2.  Melon' );
  442.   Writeln( ' ':Tab15, '3.  Juices');
  443.   Writeln( ' ':Tab15, '4.  Greens' );
  444.   Writeln( ' ':Tab15, '5.  Yellows & Reds' );
  445.   Writeln( ' ':Tab15, '6.  ', Msg1 );
  446.   V := QUIRY(6);
  447.   CLEAR;
  448.  
  449.    {*****************************************}
  450.    {  Compute the index value by assigning   }
  451.    {  a weight to each digit in the set.     }
  452.    {*****************************************}
  453.  
  454.     I := 252*F + 36*P + 6*D + V - 295
  455.  
  456.    {******************************************}
  457.  
  458. end{of InputFeatures};
  459.  
  460.  
  461.  
  462. Procedure InputRecipe;
  463. (*---------------------------------------*
  464.  *    Input individual recipies     *
  465.  *---------------------------------------*)
  466. LABEL
  467.   99; (*---EXIT---*)
  468. CONST
  469.   prompt = '>';
  470. VAR
  471.   state  : (absent, done, adding) ;
  472.   ix, jx : integer;
  473.   temp     : STRING 14;
  474.   One_Line : LINE;
  475.   YES     : boolean;
  476.     (* File descriptors <FCB> *)
  477.   current,
  478.   backup : TEXT;
  479.  
  480.   PROCEDURE CORRECT;
  481.   CONST   question = 'Are there any corrections to be made';
  482.       msg1 = 'Enter <cr> return if correct or Reenter the line';
  483.   begin
  484.     REPEAT
  485.       BREAK;
  486.       Writeln(bell,' ':(TTY_width DIV 2) -10, 'HERE IS YOUR RECIPE');
  487.       Writeln;
  488.       ShowRecipe;
  489.       Writeln;
  490.       Writeln(question);
  491.       YES := YORN;
  492.       If YES then
  493.     begin
  494.       BREAK;
  495.       Writeln(msg1);
  496.       Writeln;
  497.       For ix:=1 to 5 do
  498.         begin
  499.           REPEAT
  500.         PRINT(matrix[ix]);
  501.         SETLENGTH(one_line,0);
  502.         READLN(one_Line);
  503.         SCAN(one_Line, str_len - 1, error_flag);
  504.         If (LENGTH(one_Line) > 0) AND (error_flag=0) then
  505.           begin
  506.           APPEND(one_Line,EOS);
  507.           matrix[ix] := one_Line
  508.           end;
  509.         If error_flag IN [1,2] then
  510.           CASE error_flag of
  511.             1: writeln('Invalid length, please reinput');
  512.             2: writeln('Alpha numerics only, please reinput')
  513.           End{case}
  514.           Until error_flag=0;
  515.         end{for}
  516.     end(* If *)
  517.     Until not YES
  518.   end(*---of Correct---*);
  519.  
  520.     Function adding_desired : boolean ;
  521.     CONST    addquest = 'Do you want to ADD recipies? ';
  522.     begin
  523.       PAUSE;
  524.       BREAK;
  525.       Write(addquest);
  526.       adding_desired := YORN;
  527.       CLEAR
  528.     end;
  529.  
  530. begin(*---InputRecipe---*)
  531.   If not adding_desired then{EXIT}goto 99;
  532.   adding_recipies := true ;
  533.   state := adding ;
  534.   (* OPEN file backup_ID for WRITE assign backup *)
  535.     REWRITE(backup_ID, backup);
  536.   (* OPEN file current_ID for READ assign current *)
  537.     RESET(current_ID, current);
  538.  
  539.     {$C- [ctrl-c checking OFF]}
  540.  
  541.   If NOT EOF(current) then
  542.     begin(* COPY current to back_up *)
  543.       ix := 0 ;
  544.       While ix < Curr_Rcds do
  545.     begin
  546.       ix := SUCC(ix);
  547.       GET_RECORD(current,hash);
  548.       PUT_RECORD(backup,hash)
  549.     end(* while *)
  550.     end(* COPY current to back_up *);
  551.  
  552.     {$C+ [ctrl-c checking ON]}
  553.  
  554. (*---Input/Enter additional recipies until done---*)
  555. (*---or curr_records > Max_Records allowed     ---*)
  556.  
  557.   REPEAT
  558.   If Curr_Rcds > MaxRecords then
  559.     state := done
  560.   Else
  561.     begin(*---add more recipies---*)
  562.       Writeln('Identify Recipe with features. First ');
  563.       InputFeatures(HASH);
  564.       BREAK;
  565.       Writeln('Now Enter 5 lines of the recipe');
  566.       Writeln;
  567.       For jx := 1 to 5 DO
  568.     begin
  569.       REPEAT
  570.         write(prompt);
  571.         SETLENGTH(one_line,0);
  572.         READLN(one_line);
  573.         SCAN(one_Line, str_len - 1, error_flag);
  574.         If error_flag IN [1,2] then
  575.           CASE error_flag of
  576.           1:   writeln('Invalid length, please reinput');
  577.           2:   writeln('Alpha numerics only, please reinput')
  578.           End{case}
  579.       Until error_flag=0;
  580.       APPEND(one_Line,EOS);
  581.       matrix[jx] := one_Line
  582.     end{For};
  583.       Correct(* if required *);
  584.       Curr_Rcds := SUCC(Curr_Rcds);
  585.       PUT_RECORD(backup,hash);
  586.       If not adding_desired then state := done;
  587.     end(*---add more recipies---*)
  588.   UNTIL state<>adding;
  589. (*--------------------------------------------*)
  590. (*        SWAP file ID`s              *)
  591. (*    Back Up file is now the Current file  *)
  592. (*--------------------------------------------*)
  593.   temp := backup_ID;
  594.   backup_ID := current_ID;
  595.   current_ID := temp;
  596.  
  597.   UPDATE_MASTER;(*--status file--*)
  598.  
  599. 99:(* Come here if do not desire to add *)
  600. End{*--of InputRecipe--*};
  601.  
  602.  
  603. (*--------------------------------------*)
  604. (*          DUMP/FIND MODULE        *)
  605. (*--------------------------------------*)
  606.  
  607. PROCEDURE FILE_SCAN ;
  608. (*
  609. GLOBAL
  610.   MaxRecords = maximum allowed records
  611.   Curr_Rcds = # of recipes in file
  612. *)
  613. VAR
  614.   state : (absent, found, searching) ;
  615.   Rcds,
  616.   index : integer;
  617.   fa    : TEXT;  (* FCB. File descriptor *)
  618.  
  619.     Procedure DUMP;
  620.     (**********************************)
  621.     (*  OUTPUT all Recipes from file  *)
  622.     (**********************************)
  623.     begin
  624.       REPEAT
  625.         If Rcds > Curr_Rcds then
  626.           state := absent
  627.         Else
  628.           begin
  629.         Rcds := SUCC(Rcds);
  630.         GET_RECORD(fa,hash);
  631.         Display_One(hash);
  632.         PAUSE
  633.           end(* else *)
  634.       UNTIL state<>searching
  635.     end(*--of DUMP--*);
  636.  
  637.     Procedure FIND;
  638.     (************************************)
  639.     (*    Lookup recipes from file    *)
  640.     (************************************)
  641.     begin            {$C- [ctrl-c checking OFF]}
  642.       InputFeatures(Index);
  643.       REPEAT
  644.         If Rcds > Curr_Rcds then
  645.           state := absent
  646.         Else
  647.           begin
  648.         Rcds := SUCC(Rcds);
  649.         GET_RECORD(fa,hash);
  650.         If HASH=Index then
  651.           begin
  652.             CLEAR;
  653.             Display_One(hash);
  654.             PAUSE
  655.           end
  656.           end(* else *)
  657.       Until state<>searching
  658.     end(*--of Lookup--*);    {$C+ [ctrl-c checking ON]}
  659.  
  660. begin(*---File_Scan---*)
  661.   CLEAR;
  662.   state := absent;
  663.   If adding_recipies then{read in new stats}
  664.     OPEN_MASTER;
  665.   (* OPEN file current_ID for READ assign fa *)
  666.       RESET(current_ID, fa);
  667.   If NOT EOF(fa) then
  668.     If Curr_rcds=0 then
  669.       state := absent
  670.     Else
  671.       begin
  672.     state := searching ;
  673.     Rcds := 1 ;
  674.     CASE command of
  675.       'O', 'o':    DUMP;
  676.       'F', 'f':    FIND
  677.     End{case commmand of}
  678.       end(* else *);
  679.   If state=absent then
  680.     begin
  681.     BREAK;
  682.     Writeln('That''s all the Recipes on File')
  683.     end;
  684.   PAUSE
  685. end(*---of File_Scan---*);
  686.  
  687. (*--------------------------------------*)
  688. (*          INITIALIZATION        *)
  689. (*--------------------------------------*)
  690.  
  691.  
  692. Procedure INIT1;
  693. begin
  694.   bell        := CHR(7) ;
  695.   CRT_width    := 80 ;
  696.   TTY_width    := 72 ;
  697.   last        := str_len ;
  698.   MaxRecords    := 75 ;
  699. (*    maximum number of records =
  700.         # BYTES per Record  times  # of records
  701.     # BYTES per record = 
  702.         # chars per line + overhead per line times
  703.         # of lines.                ***)
  704.   Curr_Rcds    :=  0 ;
  705.   Last_Update    := 'YY/MM/DD      ';
  706.   current_ID    := 'RCPDAT.XXX    ';
  707.   backup_ID    := 'RCPDAT.YYY    ';
  708.   adding_recipies := false;
  709. end;
  710.  
  711. Procedure INIT2;
  712. begin
  713.    (* OPEN file `RECIPE.MST` for READ assign stats *)
  714.       RESET(master, stats);
  715.   If EOF(stats) then(* not found *)
  716.     (* OPEN file `RECIPE.MST` for WRITE assign stats *)
  717.       UPDATE_MASTER
  718.   Else
  719.     begin(* READ in data record *)
  720.       READ(stats, data );
  721.       with data do begin
  722.         MaxRecords := MR;
  723.         Curr_Rcds  := CR;
  724.         current_ID := F1;
  725.         backup_ID  := F2;
  726.         last_update := date
  727.         end(* with *)
  728.     end(* READ in data record *);
  729.   SKIP(5);
  730.   Writeln('Last update of Recipe data file was ', last_update);
  731.   Writeln('File currently consists of ', Curr_Rcds:4, ' Recipies');
  732.   Writeln;
  733.   Write('Please enter todays date <YY/MM/DD>  ');
  734.   last_update := '              ';{<<<=== 14 spaces required ===}
  735.   For ix:=1 to 8 do
  736.     begin
  737.       if (ix=3) or (ix=6) then
  738.     ch := '/'
  739.       else
  740.     KEYIN(ch);
  741.       write(ch);
  742.       last_update[ix] := ch
  743.     end{for};
  744.   writeln
  745. end(*--of INIT2---*);
  746.  
  747. (*----------------------------------------------*
  748.  *        MAIN PROGRAM            *
  749.  *----------------------------------------------*)
  750.  
  751. BEGIN
  752.   INIT1;    (* start the initialization process here *)
  753.   CLEAR;
  754.   DRAW('************',TTY_width DIV 12);
  755.   Writeln;
  756.   Writeln( ' ':22, 'The Recipe System');
  757.   Writeln;
  758.   DRAW('************',TTY_width DIV 12);
  759.   INIT2;    (* finish init now *)
  760.   { Now execute the program until done }
  761.   done := false;
  762.   While not done do
  763.     begin
  764.     CLEAR;
  765.     DRAW('************',TTY_width DIV 12);
  766.     SKIP(3);
  767.     Writeln( ' ':Tab15, 'Select One of the following:');
  768.     Writeln;
  769.     Writeln( ' ':Tab20, 'I(nput Recipes');
  770.     Writeln( ' ':Tab20, 'O(utput all Recipes');
  771.     Writeln( ' ':Tab20, 'F(ind a Recipe');
  772.     Writeln( ' ':Tab20, 'S(top');
  773.     comanding := true;
  774.     WHILE comanding do
  775.       begin
  776.       comanding := false;
  777.       Writeln;
  778.       Write(' ':(Tab15), 'Enter choice   ' );
  779.       KEYIN(command);write(command);
  780.     CASE command of
  781.       'I', 'i':    InputRecipe;
  782.       'O', 'o',
  783.       'F', 'f':    File_Scan;
  784.       'S', 's':    done := true;
  785.     Else:        begin
  786.             Write(BELL);
  787.             comanding := true
  788.             end
  789.     End{ case }
  790.       end{while comanding}
  791.     end{ while not done }
  792. End{---of Program Recipe---}.
  793.