ezlexlib.pas

很管用的GIS控件

Procedure write( aStream: TStream; const aLine: String );
Const
  WRITEBUFSIZE = 1024;
Var
  aBuffer: Array[1..WRITEBUFSIZE] Of char;
  j, nbuf: integer;
  k, nreste: integer;
Begin
  nbuf := length( aLine ) Div WRITEBUFSIZE;
  nreste := length( aLine ) - ( nbuf * WRITEBUFSIZE );
  For j := 0 To nbuf - 1 Do
  Begin
    For k := 1 To WRITEBUFSIZE Do
      aBuffer[k] := aLine[j * WRITEBUFSIZE + k];
    aStream.write( aBuffer, WRITEBUFSIZE );
  End;
  For k := 1 To nreste Do
    aBuffer[k] := aLine[nbuf * WRITEBUFSIZE + k];
  aStream.write( aBuffer, nreste );
End;

Procedure TCustomLexer.fatal( const msg: String );
(* writes a fatal error message and halts program *)
Begin
  writeln( yyerrorfile, 'LexLib: ' + msg );
  halt( 1 );
End (*fatal*);

(* I/O routines: *)

Function TCustomLexer.get_char: Char;
Var
  i: Integer;
Begin
  If ( bufptr = 0 ) And Not eof( yyinput ) Then
  Begin
    readln( yyinput, yyline );
    inc( yylineno );
    yycolno := 1;
    buf[1] := nl;
    For i := 1 To length( yyline ) Do
    begin
      buf[i + 1] := yyline[length( yyline ) - i + 1];
    end;
    inc( bufptr, length( yyline ) + 1 );
  End;
  If bufptr > 0 Then
  Begin
    get_char := buf[bufptr];
    dec( bufptr );
    inc( yycolno );
  End
  Else
    get_char := #0;
End (*get_char*);

Procedure TCustomLexer.unget_char( c: Char );
Begin
  If bufptr = max_chars Then
    fatal( 'input buffer overflow' );
  inc( bufptr );
  dec( yycolno );
  buf[bufptr] := c;
End (*unget_char*);

Procedure TCustomLexer.put_char( c: Char );
Begin
  If c = #0 Then
    { ignore }
  Else If c = nl Then
    writeln( yyoutput, '' )
  Else
    write( yyoutput, c )
End (*put_char*);

(* Variables:

   Some state information is maintained to keep track with calls to yymore,
   yyless, reject, start and yymatch/yymark, and to initialize state
   information used by the lexical analyzer.
   - yystext: contains the initial contents of the yytext variable; this
     will be the empty string, unless yymore is called which sets yystext
     to the current yytext
   - yysstate: start state of lexical analyzer (set to 0 during
     initialization, and modified in calls to the start routine)
   - yylstate: line state information (1 if at beginning of line, 0
     otherwise)
   - yystack: stack containing matched rules; yymatches contains the number of
     matches
   - yypos: for each rule the last marked position (yymark); zeroed when rule
     has already been considered
   - yysleng: copy of the original yyleng used to restore state information
     when reject is used *)

Const

  max_matches = 1024;
  max_rules = 256;

Var

  yystext: String;
  yysstate, yylstate: Integer;
  yymatches: Integer;
  yystack: Array[1..max_matches] Of Integer;
  yypos: Array[1..max_rules] Of Integer;
  yysleng: Byte;

  (* Utilities: *)

Procedure TCustomLexer.echo;
Var
  i: Integer;
Begin
  for i := 1 to yyTextLen do
    put_char(yyTextBuf^ [i])
End (*echo*);

Procedure TCustomLexer.yymore;
Begin
  if yyTextBuf <> nil then
  begin
    SetLength (yystext, yyTextLen);
    Move (yyTextBuf^, yystext [1], yyTextLen);
  end
  else yystext := '';
End (*yymore*);

Procedure TCustomLexer.yyless( n: Integer );
Var
  i: Integer;
Begin
  for i := yytextlen downto n+1 do
    unget_char(yytextbuf^ [i]);
  CheckyyTextBuf (n);
  yyTextLen := n;
End (*yyless*);

Procedure TCustomLexer.reject;
Var
  i: Integer;
Begin
  yyreject := true;
  for i := yyTextLen + 1 to yysleng do
  begin
    Inc (yyTextLen);
    yyTextBuf^ [yyTextLen] := get_char;
    //yytext := yytext + get_char;
  end;
  dec( yymatches );
End (*reject*);

Procedure TCustomLexer.returni( n: Integer );
Begin
  yyretval := n;
  yydone := true;
End (*return*);

Procedure TCustomLexer.returnc( c: Char );
Begin
  yyretval := ord( c );
  yydone := true;
End (*returnc*);

Procedure TCustomLexer.start( state: Integer );
Begin
  yysstate := state;
End (*start*);

(* yywrap: *)

Function TCustomLexer.yywrap: Boolean;
Begin
  // ????? close(yyinput); close(yyoutput);
  yywrap := true;
End (*yywrap*);

(* Internal routines: *)

Procedure TCustomLexer.yynew;
Begin
  If yylastchar <> #0 Then
    If yylastchar = nl Then
      yylstate := 1
    Else
      yylstate := 0;
  yystate := yysstate + yylstate;

  CheckyyTextBuf (Length (yystext));
  yyTextLen := Length (yystext);
  if yyTextLen > 0 then
    Move (yystext [1], yytextbuf^, yyTextLen);

  yystext := '';
  yymatches := 0;
  yydone := false;
End (*yynew*);

Procedure TCustomLexer.yyscan;
Begin
  //if Length(yytext)=255 then fatal('yytext overflow');
  yyactchar := get_char;
  CheckyyTextBuf (yyTextLen + 1);
  Inc (yyTextLen);
  yyTextBuf^ [yyTextLen] := yyactchar;
End (*yyscan*);

Procedure TCustomLexer.yymark( n: Integer );
Begin
  If n > max_rules Then
    fatal( 'too many rules' );
  yypos [n] := yyTextLen;
End (*yymark*);

Procedure TCustomLexer.yymatch( n: Integer );
Begin
  inc( yymatches );
  If yymatches > max_matches Then
    fatal( 'match stack overflow' );
  yystack[yymatches] := n;
End (*yymatch*);

Function TCustomLexer.yyfind( Var n: Integer ): Boolean;
Begin
  yyreject := false;
  While ( yymatches > 0 ) And ( yypos[yystack[yymatches]] = 0 ) Do
    dec( yymatches );
  If yymatches > 0 Then
  Begin
    yysleng := yyTextLen;

    n := yystack[yymatches];
    yyless( yypos[n] );
    yypos[n] := 0;
    if yyTextLen > 0 then
      yylastchar := yytextbuf^ [yytextlen]
    Else
      yylastchar := #0;
    yyfind := true;
  End
  Else
  Begin
    yyless( 0 );
    yylastchar := #0;
    yyfind := false;
  End
End (*yyfind*);

Function TCustomLexer.yydefault: Boolean;
Begin
  yyreject := false;
  yyactchar := get_char;
  If yyactchar <> #0 Then
  Begin
    put_char( yyactchar );
    yydefault := true;
  End
  Else
  Begin
    yylstate := 1;
    yydefault := false;
  End;
  yylastchar := yyactchar;
End (*yydefault*);

Procedure TCustomLexer.yyclear;
Begin
  bufptr := 0;
  yysstate := 0;
  yylstate := 1;
  yylastchar := #0;
  yyTextLen := 0;
  yystext := '';
End (*yyclear*);

constructor TCustomLexer.Create;
begin
  inherited Create;
  CheckyyTextBuf (intial_bufsize);
  CheckBuffer (intial_bufsize);
end;

destructor TCustomLexer.Destroy;
begin
  FreeMem (FBuf);
  FreeMem (yyTextBuf);
  inherited;
end;

procedure TCustomLexer.CheckBuffer(Index : integer);
begin
  repeat
    if Index > BufSize
      then
      begin
        bufSize := max (bufSize * 2, intial_bufsize);
        ReallocMem (FBuf, bufSize);
      end;
  until Index <= bufSize;
end;

function TCustomLexer.GetBuf(Index: Integer): Char;
begin
  CheckBuffer (Index);
  Result := FBuf^ [Index];
end;

procedure TCustomLexer.SetBuf(Index: Integer; Value: Char);
begin
  CheckBuffer (Index);
  FBuf^ [Index] := Value;
end;

procedure TCustomLexer.CheckyyTextBuf(Size : integer);
begin
  repeat
    if Size > yyTextBufSize
      then
      begin
        yyTextBufSize := max (yyTextBufSize * 2, intial_bufsize);
        ReallocMem (yyTextBuf, yyTextBufSize);
      end;
  until Size <= yyTextBufSize;
end;

procedure TCustomLexer.GetyyText(var s : string);
begin
  if yyTextLen > 0 then
  begin
    SetLength (s, yyTextLen);
    Move (yytextbuf^, s [1], yyTextLen);
  end else
    s:= '';
end;

End (*LexLib*).