home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume2 / pstrings / part01 / getsubS.p < prev    next >
Encoding:
Text File  |  1991-08-07  |  1.0 KB  |  43 lines
  1.  
  2.  
  3.  
  4.  
  5. # include "strings.h"
  6.  
  7.  
  8. function getsubS{(s: String; frompos, topos: Nat0):String};
  9. {
  10. * Returns s[frompos..topos]
  11. * Extracts a substring of s.
  12. *  returns ''  if frompos..topos not in range.
  13. }
  14.    const BufferLength = 512;
  15.    var t: String; j,i, stoppos: Nat1; ch: Char; sp: CharOfString;
  16.        buf: packed array [1..BufferLength] of Char;
  17. begin
  18.     t := nil; { -- empty string }
  19.     if topos <= lengthS(s) then begin
  20.        { --  convert max(BufferLength) chars to fixed string }
  21.        if topos-frompos+1 > BufferLength then
  22.         stoppos := frompos+BufferLength-1
  23.        else
  24.         stoppos := topos;
  25.        j := 1;
  26.        first(sp, s);
  27.        for i := 1 to frompos-1 do next(sp, ch);
  28.        for i := frompos to stoppos do begin
  29.         next(sp, ch);
  30.         buf[j] := ch;
  31.         j := j+1
  32.        end{ -- for};
  33.        { --  convert to String }
  34.        if j <> 1 then { --  positive slice }
  35.            t := mk(buf, j-1);
  36.        { --  check any more left }
  37.        if topos <> stoppos then
  38.         t := concatS(t,  getsubS(s, stoppos+1, topos))
  39.     end;
  40.     if s <> nil then if s^.REFS = 0 then disposeS(s);
  41.     getsubS := t
  42. end{ -- getsubS};
  43.