procedure WriteCode;
  begin
    CRTLine := CodeIndex + 2;
    gotoxy (1, CRTLine);
    clreol;
    write (Code [CodeIndex]);
    gotoxy (3, CRTLine);
    write (' - ', CodeDesc [CodeIndex]);
    gotoxy (29, CRTLine);
    write (' = ');
    case CodeType [CodeIndex] of
      'B': writeln (SayBool (CodeBool [CodeIndex]));
      'I': writeln (CodeInt [CodeIndex]:3);
      'S': writeln (CodeStr [CodeIndex]);
    end;
  end;

procedure LoadCodes;
  begin
    assign (CtrlFile, 'SLISTCTL.DAT');
    reset (CtrlFile);
    CodeIndex := 0;
    while not eof(CtrlFile) do
     begin
      CodeIndex := succ (CodeIndex);
      readln (CtrlFile, Code [CodeIndex]);
      readln (CtrlFile, CodeDesc [CodeIndex]);
      readln (CtrlFile, CodeType [CodeIndex]);
      readln (CtrlFile, CodeMaxLng [CodeIndex]);
      case CodeType [CodeIndex] of
        'B':
         begin
          readln (CtrlFile, WorkBool);
          if WorkBool = 'Y' then
            CodeBool [CodeIndex] := true
          else
            CodeBool [CodeIndex] := false;
         end;
        'I':
         begin
          readln (CtrlFile, CodeInt [CodeIndex]);
          CodeStr [CodeIndex] := '';
         end;
        'S':
         begin
          CodeInt [CodeIndex] := 0;
          readln (CtrlFile, CodeStr [CodeIndex]);
         end;
      end; (* Case *)
     end; (* While *)
    close (CtrlFile);
    CodeNum := CodeIndex;
  end; (* Procedure *)

procedure CopyRight;
  begin
    writeln ('*************************************************');
    writeln ('*       SLIST Version 1.00A - CP/M, Z80         *');
    writeln ('*                                               *');
    writeln ('*        (C) Copyright 1985, Herb Bowie.        *');
    writeln ('*     All commercial rights reserved.  This     *');
    writeln ('*  program is licensed for non-commercial use.  *');
    writeln ('*                                               *');
    writeln ('* Have you payed for this program yet?  If not, *');
    writeln ('* and you find it useful, then may I suggest    *');
    writeln ('* that you make a small donation to its author? *');
    writeln ('* Something like $10 would be wonderful.  You   *');
    writeln ('* may send it to:                               *');
    writeln ('*                   Herb Bowie                  *');
    writeln ('*                 P.O. Box 4724                 *');
    writeln ('*          Culver City, CA  90231-4724          *');
    writeln ('*************************************************');
  end;

(* GET-IN-FILE Proc: When program is first run will check for a file name
   passed by CP/M, and will try to open that file.  If no name is passed, will
   ask operator for a file name to open.  Proc will tell operator if file
   doesn't exist, and will allow multiple retrys.  On 2nd and later executions,
   proc will not check for CP/M passed file name.  In all cases, proc will
   assume a file type of .PAS if file type is not specified.
   PROGRAM EXIT from this proc when a null string is entered in response
   to a file name request.
*)

procedure GetInFile;          (* Gets input file name *)
  var
    Parm    : string[14] absolute $81; (* Passed file name, if any *)
    ParmLth : byte absolute $80; (* CP/M passed length of parm *)
    Existing: boolean;

  procedure  GetInName;
    begin
      LastName := InName;
      if (ParmLth in [1..14]) and First then
       begin
        InName := Copy (Parm,1,ParmLth - 1);
        if pos (':', InName) = 0 then
          InName := 'A:' + InName;
        if pos ('.', InName) = 0 then
          InName := InName + '.PAS';
       end
      else
        begin
          Clean;
          writeln;
          writeln;
          CopyRight;
          CsrUp (18);
          write ('Enter File Name or RETURN to Exit: ');
          InName := SayPic (InName, FilePic);
          write (InName);
          CsrLeft (14);
          InName := Squeeze (GetPic (InName, FilePic), Blank);
        end;
      First := false;
      AnotherFile := not (LastName = InName);
    end;

  begin
    repeat
      GetInName;
      if AnotherFile then
       begin
        Existing := DiskFile (InName);
        if Existing then
          ErrorMsg := ''
        else
          ErrorMsg := '*** FILE DOES NOT EXIST ***';
       end;
    until (not AnotherFile) or Existing;
  end;

(* GetOptions procedure gives user a chance to modify the default
   run options.
*)
procedure GetOptions;
  var
    C        : char;
    WorkValue: string [80];
    WorkPic  : string [80];
    MaxLng   : integer;
    R        : integer;
  begin
    Clean;
    for CodeIndex := 1 to CodeNum do
      WriteCode;
    writeln;
    repeat
      WriteMsg;
      gotoxy (1, CodeNum + 4);
      clreol;
      gotoxy (1, CodeNum + 5);
      clreol;
      gotoxy (1, CodeNum + 4);
      write ('Enter Code to modify, or blank to end: ');
      CodeWork := GetPic ('  ', '!!');
      writeln;
      ErrorMsg := '';
      if CodeWork <> '  ' then
       begin
        CodeIndex := 1;
        while (CodeIndex <= CodeNum)
          and (Code [CodeIndex] <> CodeWork) do
          CodeIndex := succ (CodeIndex);
        if CodeIndex > CodeNum then
          ErrorMsg := '*** INVALID SELECTION ***'
        else
         begin
          MaxLng := CodeMaxLng [CodeIndex];
          case CodeType [CodeIndex] of
            'B':
              CodeBool [CodeIndex] := not CodeBool [CodeIndex];
            'I':
             begin
              str (CodeInt [CodeIndex]:5, WorkValue);
              WorkPic := ManyChar ('9', MaxLng);
              WorkValue := SayPic (WorkValue, WorkPic);
              write ('Enter new value: ', WorkValue);
              CsrLeft (MaxLng);
              WorkValue := GetPic (WorkValue, WorkPic);
              val (WorkValue, CodeInt [CodeIndex], R);
             end;
            'S':
             begin
              if MaxLng > 5 then
                WorkPic := ManyChar ('X', MaxLng)
              else
                WorkPic := ManyChar ('!', MaxLng);
              WorkValue := SayPic (CodeStr [CodeIndex], WorkPic);
              write ('Enter new value: ', WorkValue);
              CsrLeft (MaxLng);
              CodeStr [CodeIndex]
                := GetPic (WorkValue, WorkPic);
             end;
          end;  (* of case *)
          WriteCode;
         end; (* valid work code *)
       end; (*non-blank work code *)
    until CodeWork = '  ';
  end;
