Power-Programmierung/CD1.mdf/pascal/library/dos/answcode/newpoint.pas

Pascal/Delphi Source File | 1988-10-27 | 5KB | 224 lines

Unit NewPoint;
{$R-,S-,I-,N-,D-,T-,F+,B+}

INTERFACE

Uses Crt,Library,Wndw,Wndwvars,Qwik,TAccess,TAHigh;

Procedure MakePointers;
IMPLEMENTATION

Procedure MakePointers;
Type
   IndexType = String[6];
   CommonType = Array[1..1000] of string[6];
   ParseType = String[12];
   Sorted = Record
    KeyWord : String[12];
    end;

   Pointers = Record
        IndexWord : IndexType;
          PtrArray : Array[1..200] of Integer;
         end;

   String6 = String[6];

MaxDataType = Pointers;
MaxKeyWordType = IndexType;

Var
    SortFile : File of Sorted;
    PointerFile : DataSet;
   FileName : String[8];
    A,J,K,M,Per : Integer;
    I : LongInt;
    PointerRec : Pointers;
    SortRec : Sorted;
    CommonWords : CommonType;
   SearchKey : String[6];
    KeyLine : ParseType;
   CommonFile : Text;
    IntValue,LineCount,Position,Result : Integer;
   Line : String[6];
    Empty,Exact,Found : Boolean;


Procedure AddPointer;

Var
    X : Integer;

Procedure SchStBin(var TextArray : CommonType;LineCount,Position : Integer;
          TextKey : ParseType;var Result : Integer);


var
   Low,High,J,Width : Integer;

begin
   Result := -1;
   Width := Length(TextKey);
   if width <1 then exit;
   low := 1;
   high := LineCount;
   while high>=low do
   begin
        J := (low + high) div 2;
        if textkey<copy(textarray[J],Position,width) then
        high := j-1
        else
        if textkey>copy(textarray[J],position,width) then
        low := j+1
        else
        begin
        result :=j;
        exit
        end
        end
        end;

Procedure ParseIn(SourceStr:ParseType;var Position:Integer;var Found:Boolean;var IntValue:Integer);

var
   SourceLen,TrialLen,Code : Integer;

begin
     SourceLen := length(SourceStr);
     IntValue := 0;
     Found := False;
     If not (Position in [1..SourceLen]) then
     exit;
     TrialLen := SourceLen-Position+1;
     repeat
           val(copy(SourceStr,Position,TrialLen),IntValue,Code);
           if Code>TrialLen then
              Code := TrialLen;

           if Code>0 then
              TrialLen := Code-1

     until
          (TrialLen=0) or (Code=0);
          if (Code=0) then
          begin
          Found := True;
          Position := Position+TrialLen;
          If Position>SourceLen then
          Position := 0
          end

end;



begin
    with SortRec do
    begin
    KeyLine := KeyWord;
    A := Pos(',',KeyLine);
    SearchKey := PadR(Copy(KeyLine,1,A-1),6);
    Position := 1;
    SchStBin(CommonWords,LineCount,Position,SearchKey,Result);
    If Result>=0 then Exit;
    Position := A+1;
    ParseIn(KeyLine,Position,Found,IntValue);
    end;
    TARead(PointerFile,PointerRec,SearchKey,Exact);
    If OK then
        begin
        K := 1;
        Empty := True;
        with PointerRec do
        begin
      while Empty do
        begin
        If PtrArray[K] = 0 then
        begin
        If PtrArray[Pred(K)]<>IntValue then PtrArray[K] := IntValue
      else Exit;
        Empty := False;
        end
        else K := K + 1;
        If K = 200 then exit;
        end;
        end;
        TAUpdate(PointerFile,PointerRec,SearchKey);
        Exit;
      end
        else
        begin
        with PointerRec do
        begin
        For X:= 1 to 200 do
        PtrArray[X] := 0;
      IndexWord := SearchKey;
        PtrArray[1] := IntValue;
        end;
        TAInsert(PointerFile,PointerRec,PointerRec.IndexWord);
        end;
end;


Var
    Loop : Integer;

begin
ClrScr;
InitWindow(0,True);
MakeWindow(17,1,8,80,White+RedBG,White+RedBG,DoubleBrdr,Window30);
gotoxy(2,3);
write('                             ANSWERS ! Version 4.0');
gotoxy(2,4);
write('                           Copyright 1988 Brian Corll');
gotoxy(2,5);
write('                               All Rights Reserved');
MakeWindow(10,11,5,62,White+BlueBG,White+BlueBG,DoubleBrdr,Window3);
QWrite(12,26,White+BlueBG,'Loading Vocabulary of Common Words');
Per := Pos('.',ParamStr(1));
If Per>0 then
    FileName := Copy(ParamStr(1),1,Per-1)
else
    FileName := ParamStr(1);
    Assign(SortFile,FileName+'.srt');
    Reset(SortFile);
   Assign(CommonFile,'common.wds');
    Reset(CommonFile);
    I := 1;
    while not eof(CommonFile) do
    begin
   Readln(CommonFile,Line);
    CommonWords[I] := PadR(Line,6);
    I := I + 1;
    end;
    Close(CommonFile);
    Delay(2000);
    LineCount := I;
    I := 1;
    RemoveWindow;
    SetWindowModes(ZoomMode);
   MakeWindow(10,11,5,62,Black+LightGrayBG,Black+LightGrayBG,DoubleBrdr,Window3);
    gotoxy(2,1);
    write('               Creating Index and Pointer Files.');
    gotoxy(2,2);
    write('               Processing Word Number ');
    TACreate(PointerFile,FileName+'.ptr',SizeOf(PointerRec),FileName+'.ndx',SizeOf(IndexType)-1);
    while not eof(SortFile) do
    begin
      gotoxy(41,2);
        write(I);
        Seek(SortFile,I-1);
        Read(SortFile,SortRec);
      AddPointer;
        I := I + 1;
   end;
    TAClose(PointerFile);
    Close(SortFile);
end;


END.