PROGRAM tester(input, output);
(* testing string package. *)

(*$i'strings.dec' (may need extra operations here on other systems) *)

  VAR
    stest,
    ssub        : string;
    s           : ARRAY[1..4] OF string;
    i, j, v     : integer;
    ch          : char;

01000000(*$i'strings.inc' line number control *)

08015000  FUNCTION getreply : char; (* 1 char from console, and flush line *)

    BEGIN (* getreply *)
    getreply := input^; readln;    (* coded for ISO std file system *)
    END; (* getreply *)

  (* 1---------------1 *)

{ PROCEDURE prompt; }
  (* uncomment this for systems that do not buffer output, and     *)
  (* that do not have the prompt procedure.  If the system buffers *)
  (* output you must install code to force flushing the buffer to  *)
  (* the console, without any final <cr> or <lf>.                  *)

{   BEGIN (* prompt *)  }
{   END; (* prompt *)   }

  (* 1---------------1 *)

  PROCEDURE showstrings(max : integer);

    VAR
      i    : integer;

    BEGIN (* showstrings *)
    FOR i := 1 TO max DO BEGIN
      write(i : 1, '(', length(s[i]) : 2, ') "');
      writestring(output, s[i]);
      writeln('"'); END;
    END; (* showstrings *)

  (* 1---------------1 *)

  PROCEDURE showrelation(i, j : integer);

    BEGIN (* showrelation *)
    write(i : 1);
    IF s[i] > s[j] THEN write(' > ')
    ELSE IF s[i] < s[j] THEN write(' < ')
    ELSE IF s[i] = s[j] THEN write(' = ')
    ELSE write(' BUG ');
    writeln(j : 1);
    END; (* showrelation *)

  (* 1---------------1 *)

  BEGIN (* test *)
  REPEAT
    (* Showing a method (non-standard) of initializing strings *)
    (* Unfortunately this requires counting string characters  *)
    (* and use of the s- option to enable the substring op.    *)
(*$s-*)
    s[4, 1 FOR 18] := 'Initialized string'; s[4, 19] := eos;
(*$s+                  1234567890123456789  DON'T FORGET EOS *)

    FOR i := 1 TO 3 DO BEGIN
      write('Enter string[', i:1, ']:'); prompt;
      readlnstring(input, s[i]); END;
    writeln; showstrings(4);

    writeln; writeln('Trailing blanks removed');
    FOR i := 1 TO 3 DO stringdeblank(s[i]);
    showstrings(3);

    writeln; writeln('In a field of 60 chars');
    FOR i := 1 TO 3 DO BEGIN
      write('"'); wrtfldstring(output, s[i], 60); writeln('"'); END;
    write(' ');
    FOR i := 1 TO 60 DO write(i MOD 10 : 1);
    writeln;

    write('<ret> to continue'); prompt; readln;

    stringextend(s[1], ' ', false); stringextend(s[2], ' ', false);
    concat(s[1], s[2], s[4]); concat(s[4], s[3], s[4]);
    writeln; writeln('Single blanks at end, concatenated');
    showstrings(4);

    writeln; writeln('Substring at 4 for 8 chars');
    FOR i := 1 TO 3 DO BEGIN
      substring(s[i], 4, 8, stest);
      write(i : 1, '(', length(stest) : 2, ') "');
      writestring(output, stest); writeln('"'); END;

    writeln; writeln('String relationships');
    substring(s[1], 1, 8, s[4]);
    FOR i := 1 TO 4 DO stringclean(s[i]); (* needed for relation *)
    showstrings(4);
    FOR i := 1 TO 3 DO
      FOR j := succ(i) TO 4 DO showrelation(i, j);

    write('<ret> to continue'); prompt; readln;

    writeln; write('Enter string to search for ='); prompt;
    readlnstring(input, ssub);
    FOR i := 1 TO 3 DO BEGIN
      j := stringfind(ssub, s[i], 1);
      IF j > 0 THEN BEGIN
        wrtfldstring(output, s[i], succ(length(s[i]))); writeln;
        writeln(' ' : j, '^');
        REPEAT
          j := stringfind(ssub, s[i], succ(j));
          IF j > 0 THEN writeln(' ' : j, '^');
        UNTIL j = 0; END
      ELSE writeln('Not found in string', i : 2); END;

    writeln; writeln('Upshifting strings');
    FOR i := 1 TO 4 DO stringupshift(s[i]);
    showstrings(4);

    writeln; writeln('Numeric values of strings');
    FOR i := 1 TO 4 DO BEGIN
      write(i : 1);
      IF stoi(s[i], 1, v) = 0 THEN write(' has no value')
      ELSE write(' = ', v : 1);
      writeln; END;

    write('Again (y/n) ? '); prompt;
  UNTIL NOT (getreply IN ['Y', 'y']);
  END. (* test *)