program chk_text ;
{ CHK_TEXT  FILE0000.CHK -> FILE0000.CH!  Text recovery utility
  Copy, but only sectors seemingly likely to contain words - defined by
  four consecutive letters at least nine times - or adjacent ? }

uses Crt ;

type sector = array [0..511] of char ;
section = record Sctr : sector ; Txt : boolean end ;
PSection = ^Section ;

var InFi, OuFi : file of sector ;

const
P1 : PSection = NIL ;
P2 : PSection = NIL ;

const SectorsInput : word = 0 ; SectorsOutput : word = 0 ;
var SectorsInInputFile : word ;

function TextInPSect(PS : PSection) : boolean ;
var Ch, CharCount, WordCount : word ;
begin CharCount := 0 ; WordCount := 0 ;
  for Ch := 0 to 511 do begin
    if UpCase(PS^.Sctr[Ch]) in ['A'..'Z'] then Inc(CharCount) else begin
      if CharCount>4 then Inc(WordCount) ; CharCount := 0 end ;
    end {Ch} ;
  TextInPSect := WordCount>9 ;
  end {TextInPSect} ;

procedure MaybeWriteSector(P : PSection) ;
begin
  if P^.Txt then begin Inc(SectorsOutput) ; Write(OuFi, P^.Sctr) end ;
  Write(SectorsOutput:6, SectorsInput:6, '/', SectorsInInputFile, ^M) ;
end {MaybeWriteSector} ;

const ThatWasText : boolean = false ;
var FileName : string ;

BEGIN Writeln('CHK_TEXT   www.merlyn.demon.co.uk  >=1998/02/27') ;
FileName := ParamStr(1) ;
Assign(InFi, FileName) ; Reset(InFi) ;
FileName[Length(FileName)] := '!' ;
Assign(OuFi, FileName) ; Rewrite(OuFi) ;
SectorsInInputFile := FileSize(InFi) ;

while not EoF(InFi) do begin Inc(SectorsInput) ;
  New(P2) ; P2^.Txt := ThatWasText ; Read(InFi, P2^.Sctr) ;
  ThatWasText := TextInPSect(P2) ;
  if ThatWasText then begin P2^.Txt := true ; P1^.Txt := true end ;
  MaybeWriteSector(P1) ;
  if P1<>NIL then Dispose(P1) ;
  P1 := P2 ;
  end ;
MaybeWriteSector(P1) ;
Close(OuFi) ; Close(InFi) ;
Writeln(^J, FileName) ;
END.  JRS 95/12/26 ff.