home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / sampler / 02 / parser / strlib3.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-09-06  |  3.2 KB  |  138 lines
  1. {STRLIB3.PAS}
  2. {
  3. Description:  Library of extended string handling routines for parsing
  4.               demonstrations
  5. Author:       Karl Gerhard
  6. Date:         8/13/87
  7. Application:  IBM PC and compatibles
  8. }
  9.  
  10. type string1 = string[1];
  11. {---------------------------------}
  12. Function color(f,b:integer):string1;
  13. { set color, return null }
  14. Begin
  15. textcolor(f);
  16. textbackground(b);
  17. color := '';
  18. End;
  19.  
  20. {---------------------------------}
  21. Function strrtrim(s:stdstr):stdstr;
  22. { delete blanks on right of string }
  23. var i:integer;
  24. Begin
  25. i := length(s);
  26. while (i > 0) and (s[i] = ' ') do i := i - 1;
  27. s[0] := chr(i);
  28. strrtrim := s;
  29. End;
  30.  
  31.  
  32. {---------------------------------}
  33. Function strltrim(s:stdstr):stdstr;
  34. { delete blanks on left of string }
  35. var i:integer;
  36. Begin
  37. while (0 < length(s) ) and (s[1] = ' ') do delete(s,1,1);
  38. strltrim := s;
  39. End;
  40.  
  41. {---------------------------------}
  42. Function struc(s:stdstr):stdstr;
  43. { capitalize a string }
  44. Var i:integer;
  45. Begin
  46. for i := 1 to length(s) do  s[i] := upcase( s[i] );
  47. struc := copy(s,1,i);
  48. End;
  49.  
  50. {---------------------------------}
  51. Function bool(b:boolean):stdstr;
  52. { return printable string for boolean }
  53. Begin if b then bool := 'True' else bool := 'False';  End;
  54.  
  55. {---------------------------------}
  56. Function strint(n:integer):stdstr;
  57. { return printable string for an integer }
  58. Var s:stdstr;
  59. Begin
  60. str(n,s);
  61. strint := ' ' + s + ' ';
  62. End;
  63.  
  64. {---------------------------------}
  65. Function nextword(s:stdstr; var ptr:integer):stdstr;
  66. { get next word from the input, advance ptr }
  67. Var
  68. inlen,ps:integer;
  69. Begin
  70. inlen := length(s);
  71. s := s + ' ';
  72.  
  73. { skip leading blanks }
  74. ps := ptr;
  75. if ps < inlen then
  76. while (ps <= inlen ) and (s[ps] = ' ') do ps := ps + 1;
  77.  
  78. { find end of the word }
  79. if ps <= inlen then begin
  80.   ptr := ps - 1;
  81.   repeat  ptr := ptr + 1;
  82.   until (ptr >= inlen ) or (s[ptr + 1] = ' ' );
  83.   if (ptr > inlen ) then error('nextword','ptr exceeds string length');
  84.   s := copy(s, ps, ptr - ps + 1);
  85. end
  86. else
  87.   s := '';
  88.  
  89. s := strrtrim(s);
  90. nextword := s;
  91. ptr := ptr + 1;
  92. { logging('nextword',' ' + strint(ptr) + '[' + s + ']');{}
  93. End;
  94.  
  95.  
  96. {---------------------------------}
  97. Function getoken:stdstr;
  98. { get next word from the input array, advance token_ptr }
  99. Var  s:stdstr;
  100. n,ps:integer;
  101. Begin
  102.  
  103. { skip leading blanks }
  104. if token_ptr < input_length then
  105. while (token_ptr <= input_length ) and
  106.   (input_array[token_ptr] = ' ') do token_ptr := token_ptr + 1;
  107.  
  108. { detect punctuation as next token }
  109. if input_array[token_ptr] in[#33..#47,#58..#64] then begin
  110.   { detect double punctuation as next token }
  111.   if input_array[token_ptr + 1] in['=','>']  then begin
  112.     s := input_array[token_ptr] + input_array[token_ptr + 1];
  113.     token_ptr := token_ptr + 1;
  114.   end
  115.   else
  116.     s := input_array[token_ptr];
  117.   token_ptr := token_ptr + 1;
  118. end
  119.  
  120. { find end of the word }
  121. else if token_ptr <= input_length then begin
  122.   ps := token_ptr ;
  123.   while (token_ptr <= input_length ) and
  124.     not (input_array[token_ptr] in[#32..#47,#58..#64] )
  125.     do  token_ptr := token_ptr + 1;
  126.  
  127.   move(input_array[ps], s[1],token_ptr - ps);
  128.   s[0] := chr(token_ptr - ps);
  129. end
  130. else
  131.   s := '';
  132.  
  133. getoken := s;
  134. logging('  GETOKEN ',s);
  135. End;
  136.  
  137. 
  138.