[Back to STRINGS SWAG index]  [Back to Main SWAG index]  [Original]

{
GV> Hi Wim,
Hi Greg...

GV> It wouldn't be difficult to write Pos, Copy, Assign, etc., which
GV> operate on an ARRAY OF CHAR -- using the ASCIIZ scheme, or a length
GV> WORD (rather than length byte) at array elements [0] and [1].

As you can see in a other message has wim van der vegt written a
complete unit with these functions :-)

it was a 'little' bit reprogramming to implement these new functions but
it was worth while <g>

GV> Greg_
Thanx for your answer, Wim

here is the code :
}

Unit MyStr;

INTERFACE


Const
  maxlength  = 512;
  nul        = #00;
  cr         = #13;
  lf         = #10;
  sp         = #32;

Type
  indexrange = 0..maxlength;
  stringtype = Record
                 length : indexrange;
                 chars  : Array[1..maxlength] Of char;
               End;


Function  Long_Length(s : stringtype) : indexrange;
Procedure Long_Readln(Var f : text;var l : stringtype);
Procedure Long_Write(Var f : text;var l : stringtype);
Procedure Long_Writeln(Var f : text;var l : stringtype);
Procedure Long_Copy(s : stringtype;Var d : stringtype; index,count : indexrange);
Procedure Long_Concat(Var d : stringtype;s : String);

IMPLEMENTATION
{---------------------------------------------------------}
{  Author  : Ir. G.W. van der Vegt                        }
{  Project : Longer strings                               }
{  Source  : Pascal + Data Structures by Dale/Lilly       }
{            ISBN 0-669-07239-7                           }
{---------------------------------------------------------}
{  Modified to give less errors and act more like TP's    }
{  functions. Can be made more efficient by using move,   }
{  moving the inc of length's out of the for loops and    }
{  not using the Length function to calc the length but   }
{  use the field in the record. etc.                      }
{---------------------------------------------------------}
{  Because Turbo Pascal's Functions won't return records  }
{  most of the Turbo Pascal String functions equivalents  }
{  can only be procedures.                                }
{---------------------------------------------------------}
{  The code hasn't been tested well yet so expect some    }
{  errors to be in it. All I have detected are fixed.     }
{  For testing set maxlength at 20 or 30.                 }
{---------------------------------------------------------}


Function Long_Length(s : stringtype) : indexrange;

Begin
  Long_Length:=s.length;
End;

Procedure Long_Readln(Var f : text;var l : stringtype);

Begin
  l.length:=0;
  Fillchar(l.chars,maxlength,sp);
  While NOT(Eoln(f) OR Eof(f)) AND (l.length<maxlength) Do
    Begin
      Inc(l.length,1);
      System.Read(f,l.chars[l.length]);
    End;

  IF Not(eof(f)) Then System.readln(f);
End;

Procedure Long_Write(Var f : text;var l : stringtype);

Var
  pos : indexrange;

Begin
  For pos:=1 To Long_Length(l) DO
    System.Write(f,l.chars[pos]);
End;

Procedure Long_Writeln(Var f : text;var l : stringtype);

Var
  pos : indexrange;

Begin
  For pos:=1 To Long_Length(l) DO
    System.Write(f,l.chars[pos]);
  System.Write(f,cr,lf);
End;

Procedure Long_Copy(s : stringtype;Var d : stringtype; index,count : indexrange);

Var
  poss,
  posd : indexrange;

Begin
  d.length:=0;
  Fillchar(d.chars,maxlength,sp);

  posd:=0;
  poss:=index;

  WHILE (posd<count) AND (poss<=maxlength) Do
    Begin
      Inc(d.length,1);
      Inc(posd,1);
      d.chars[posd]:=s.chars[poss];
      Inc(poss,1);
    End;
End;

Procedure Long_Concat(Var d : stringtype;s : String);

Var
  posd,
  poss : indexrange;
Begin
  posd:=Long_Length(d);
  poss:=0;
  While (posd<maxlength) AND (poss<Length(s)) Do
    Begin
      Inc(poss,1);
      Inc(posd,1);
      d.chars[posd]:=s[poss];
      Inc(d.length,1);
    End;
End;



(*
Var
  inf : text;
  s,d : stringtype;

Begin
  Assign(inf,'LSTRING.PAS');
  Reset(inf);
  While NOT(eof(inf)) Do
    Begin
      Readln(inf,s);
      Copy(s,d,1,4);
      Writeln(output,s);
      Writeln(output,d);
      Concat(d,s);
      Writeln(output,d);
    End;
*)

End.

[Back to STRINGS SWAG index]  [Back to Main SWAG index]  [Original]