program CribDrag;	{ 4/27/10 Paste con into a text file }
     var
       str, str1, tipv, tip, tippat: string;
       i, len, tm, lt: integer;
       Infile: text;    { defines the type of file to be read }
   function patstr (cstr: string): string;{ gets pattern string }
     var
       i, j, ls: integer;
       dstr: string;
      tpat: array[1..50] of integer;
  begin
    ls := length(cstr);  { get length of string }
    dstr := '';
    for i := 1 to ls - 1 do
      for j := i + 1 to ls do
        if cstr[i] = cstr[j] then
          begin
            tpat[i] := j - i; { gives integral distance }
            break;  { found one for this i, don't look further }
          end
        else
          tpat[i] := 0; { no duplicate found for this i }
    for i := 1 to ls - 1 do
      if tpat[i] > 9 then
        dstr := concat(dstr,chr(tpat[i] + 55))  { letter }
      else
        dstr := concat(dstr,chr(tpat[i] + 48)); { number }
    patstr := dstr;
  end;     { of function patstr }
  begin    { main routine }
    write(' ENTER THE FILE NAME ("-1" to quit): ');
    readln(str1);         { read in name of con file }
    if str1 = '-1' then
      halt;
    assign(Infile, str1); { associate Infile with name str1 }
    {$I-}
    reset(Infile);        { open Infile }
    {$I+}
    if IOResult <> 0 then
      begin
        writeln(' Error opening file ',str1);
        write(' PRESS <Enter>:');
        readln;
        halt;
      end;
    str := '';            { start with blank string str }
    while not eof(Infile) do	 { go to end of file (eof) }
      begin
        readln(Infile, str1); { read a line of con into str1 }
        for i := 1 to length(str1) do { look at each character }
          if ord(str1[i]) > 64 then   { if upper case letter }
            str := str + str1[i];     { build string str }
      end;  { of while }
    write(' ENTER THE TIP ("-1" to quit): ');
    readln(tip);
    if tip = '-1' then
      halt;
    tippat := patstr(tip);   { get tip pattern string }
    len := length(str);      { length of con }
    lt := length(tip);       { length of tip }
    writeln(' ',str);
    write(' Length=',len:3,', Tip=',upCase(tip));
    writeln(', Tip pattern word=',tippat);
    tm := 0;       { tip match counter }
    for i := 1 to len - lt + 1 do { drag tip through ct }
      begin
        tipv := copy(str,i,lt);   { tip-size ct at position i }
        if patstr(tipv) = tippat then
          begin
            writeln(' Tip match at position', i:4,' ',tipv);
            tm := tm + 1;    { increment tip match counter }
          end;
      end; { of i loop}
    writeln(' Number of tip matches =', tm:2);
    write(' PRESS <RETURN>:');
    readln;   {waits for RETURN key before closing the window }
  end.