home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / oberon / jacob-v0.1 / jacob-v0 / jacob / lib / Str.ob2 < prev    next >
Encoding:
Text File  |  1996-04-04  |  6.4 KB  |  210 lines
  1. MODULE Str;
  2. IMPORT SL:=SysLib, SYS:=SYSTEM;
  3.  
  4. TYPE T* = POINTER TO ARRAY OF CHAR;
  5. VAR nullCh:T; HexDigits:ARRAY 17 OF CHAR; 
  6. VAR t:ARRAY 5 OF CHAR; 
  7.  
  8. PROCEDURE^Length*(s:ARRAY OF CHAR):LONGINT; 
  9.  
  10. (************************************************************************************************************************)
  11. PROCEDURE Alloc*(s:ARRAY OF CHAR):T;
  12. VAR t:T; n:LONGINT; 
  13. BEGIN (* Alloc *)
  14.  IF s[0]=0X THEN RETURN nullCh; END; (* IF *)
  15.  
  16.  n:=Length(s); 
  17.  NEW(t,n+1); 
  18.  SYS.MOVE(SYS.ADR(s),SYS.ADR(t^),n); 
  19.  t[n]:=0X; 
  20.  
  21.  RETURN t; 
  22. END Alloc;
  23.  
  24. (************************************************************************************************************************)
  25. PROCEDURE Length*(s:ARRAY OF CHAR):LONGINT; 
  26. VAR i:LONGINT; 
  27. BEGIN (* Length *)
  28.  FOR i:=0 TO LEN(s)-1 DO
  29.   IF s[i]=0X THEN RETURN i; END; (* IF *)
  30.  END; (* FOR *)               
  31.  RETURN LEN(s); 
  32. END Length;
  33.  
  34. (************************************************************************************************************************)
  35. PROCEDURE Append*(VAR s:ARRAY OF CHAR; t:ARRAY OF CHAR);
  36. VAR src,dst:LONGINT; c:CHAR; 
  37. BEGIN (* Append *)   
  38.  dst:=0; 
  39.  WHILE s[dst]#0X DO
  40.   INC(dst); 
  41.   IF dst>=LEN(s) THEN RETURN; END; (* IF *)
  42.  END; (* WHILE *)          
  43.  
  44.  src:=0; 
  45.  LOOP
  46.   IF dst>=LEN(s) THEN s[LEN(s)-1]:=0X; RETURN; END; (* IF *)
  47.   IF src>=LEN(t) THEN s[dst]:=0X; RETURN; END; (* IF *)
  48.   c:=t[src]; s[dst]:=c; 
  49.   IF c=0X THEN RETURN;END; (* IF *)
  50.   INC(src); INC(dst); 
  51.  END; (* LOOP *)
  52. END Append;
  53.  
  54. (************************************************************************************************************************)
  55. PROCEDURE Caps*(VAR s:ARRAY OF CHAR);
  56. VAR i:LONGINT; c:CHAR; 
  57. BEGIN (* Caps *)
  58.  FOR i:=0 TO LEN(s)-1 DO
  59.   c:=s[i]; 
  60.   IF c=0X THEN RETURN; END; (* IF *)
  61.   s[i]:=CAP(c); 
  62.  END; (* FOR *)
  63. END Caps;
  64.  
  65. (************************************************************************************************************************)
  66. PROCEDURE CharPos*(s:ARRAY OF CHAR; c:CHAR):LONGINT; 
  67. VAR i:LONGINT; 
  68. BEGIN (* CharPos *)                     
  69.  FOR i:=0 TO LEN(s)-1 DO
  70.   IF s[i]=c THEN RETURN i; END; (* IF *)
  71.  END; (* FOR *)           
  72.  RETURN -1; 
  73. END CharPos;
  74.  
  75. (************************************************************************************************************************)
  76. PROCEDURE Concat*(VAR r:ARRAY OF CHAR; s1,s2:ARRAY OF CHAR);
  77. VAR src,dst:LONGINT; c:CHAR; 
  78. BEGIN (* Concat *)
  79.  dst:=0; src:=0; 
  80.  LOOP
  81.   IF dst>=LEN(r) THEN r[LEN(r)-1]:=0X; RETURN; END; (* IF *)
  82.   IF src>=LEN(s1) THEN EXIT; END; (* IF *)
  83.   c:=s1[src]; r[dst]:=c; 
  84.   IF c=0X THEN EXIT; END; (* IF *)
  85.   INC(src); INC(dst); 
  86.  END; (* LOOP *)
  87.  
  88.  src:=0; 
  89.  LOOP
  90.   IF dst>=LEN(r) THEN r[LEN(r)-1]:=0X; RETURN; END; (* IF *)
  91.   IF src>=LEN(s2) THEN r[dst]:=0X; RETURN; END; (* IF *)
  92.   c:=s2[src]; r[dst]:=c; 
  93.   IF c=0X THEN RETURN;END; (* IF *)
  94.   INC(src); INC(dst); 
  95.  END; (* LOOP *)
  96. END Concat;
  97.  
  98. (************************************************************************************************************************)
  99. PROCEDURE Delete*(VAR r:ARRAY OF CHAR; p,l:LONGINT);
  100. VAR i,len:LONGINT; 
  101. BEGIN (* Delete *)
  102.  IF (l<=0) OR (p<0) THEN RETURN; END; (* IF *)
  103.  
  104.  len:=Length(r); 
  105.  IF p>=len THEN RETURN; END; (* IF *)
  106.  
  107.  IF p+l>=len THEN r[p]:=0X; RETURN; END; (* IF *)
  108.  FOR i:=p+l TO len-1 DO r[i-l]:=r[i]; END; (* FOR *)
  109.  r[len-l]:=0X; 
  110. END Delete;
  111.  
  112. (************************************************************************************************************************)
  113. PROCEDURE IntToStr*(v:LONGINT; VAR s:ARRAY OF CHAR; base:LONGINT; VAR ok:BOOLEAN);
  114. VAR c:CHAR; negative:BOOLEAN; dst:LONGINT; buf:ARRAY 20 OF CHAR; 
  115. BEGIN (* IntToStr *)
  116.  ok:=FALSE; 
  117.  IF base>16 THEN RETURN; END; (* IF *)
  118.  
  119.  negative:=(v<0); v:=ABS(v); dst:=LEN(buf)-1; buf[LEN(buf)-1]:=0X; 
  120.  REPEAT
  121.   DEC(dst); buf[dst]:=HexDigits[v MOD base]; v:=v DIV base; 
  122.  UNTIL v=0;
  123.  
  124.  IF negative THEN DEC(dst); buf[dst]:='-'; END; (* IF *)                 
  125.  IF LEN(s)-1 < LEN(buf)-dst THEN RETURN; END; (* IF *)
  126.  SYS.MOVE(SYS.ADR(buf[dst]),SYS.ADR(s),LEN(buf)-dst+1); 
  127.  ok:=TRUE; 
  128. END IntToStr;
  129.  
  130. (************************************************************************************************************************)
  131. PROCEDURE StrToInt*(s:ARRAY OF CHAR):LONGINT; 
  132. VAR v,i:LONGINT; c:CHAR; 
  133. BEGIN (* StrToInt *)
  134.  v:=0; i:=0; 
  135.  LOOP
  136.   IF i>=LEN(s) THEN EXIT; END; (* IF *)
  137.   c:=s[i]; 
  138.   IF c=0X THEN EXIT; END; (* IF *)
  139.   IF ('0'<=c) & (c<='9') THEN v:=10*v+ORD(c)-48; END; (* IF *)
  140.   INC(i); 
  141.  END; (* LOOP *)
  142.  RETURN v; 
  143. END StrToInt;
  144.  
  145. (************************************************************************************************************************)
  146. PROCEDURE FixRealToStr*(v:LONGREAL; prec:LONGINT; VAR s:ARRAY OF CHAR; VAR ok:BOOLEAN);
  147. CONST mantlen=30;
  148. VAR mant,decpt,sign,start,src,dst:LONGINT; buf:ARRAY 500 OF CHAR; 
  149. CONST frac=LEN(buf) DIV 2;
  150. BEGIN (* FixRealToStr *)
  151.  ok:=FALSE; 
  152.  s[0]:=0X; 
  153.  IF (prec<0) OR (frac+prec>=LEN(buf)) THEN RETURN; END; (* IF *)
  154.  
  155.  mant:=SL.ecvt(v,mantlen,decpt,sign); 
  156.  
  157.  SYS.MOVE(mant,SYS.ADR(buf),mantlen+1); 
  158.  
  159.  IF decpt<=0 THEN 
  160.     IF frac-decpt+mantlen >= LEN(buf) THEN RETURN; END; (* IF *)
  161.     start:=frac-1; 
  162.     FOR dst:=start TO frac-decpt-1 DO buf[dst]:='0'; END; (* FOR *)
  163.     SYS.MOVE(mant,SYS.ADR(buf[frac-decpt]),mantlen); 
  164.     FOR dst:=frac-decpt+mantlen TO LEN(buf)-1 DO buf[dst]:='0'; END; (* FOR *)
  165.  ELSE
  166.     start:=frac-decpt; 
  167.     IF start<0 THEN RETURN; END; (* IF *)
  168.     SYS.MOVE(mant,SYS.ADR(buf[start]),mantlen); 
  169.     FOR dst:=start+mantlen TO LEN(buf)-1 DO buf[dst]:='0'; END; (* FOR *)
  170.  END; (* IF *)
  171.  
  172.  dst:=0; 
  173.  IF sign=1 THEN s[dst]:='-'; INC(dst); END; (* IF *)
  174.  
  175.  FOR src:=start TO frac-1 DO
  176.   IF dst>=LEN(s) THEN RETURN; END; (* IF *)
  177.   s[dst]:=buf[src]; INC(dst); 
  178.  END; (* FOR *)           
  179.  
  180.  IF dst>=LEN(s) THEN RETURN; END; (* IF *)
  181.  s[dst]:='.'; INC(dst); 
  182.  
  183.  FOR src:=frac TO frac+prec-1 DO
  184.   IF dst>=LEN(s) THEN RETURN; END; (* IF *)
  185.   s[dst]:=buf[src]; INC(dst); 
  186.  END; (* FOR *)
  187.  
  188.  IF dst>=LEN(s) THEN RETURN; END; (* IF *)
  189.  s[dst]:=0X; 
  190.  ok:=TRUE; 
  191. END FixRealToStr;
  192.  
  193. (************************************************************************************************************************)
  194. PROCEDURE StrToReal*(s:ARRAY OF CHAR; VAR ok:BOOLEAN):LONGREAL;
  195. VAR v:LONGREAL; p,end:LONGINT;
  196. BEGIN (* StrToReal *)
  197.  p:=CharPos(s,'D'); 
  198.  IF p>-1 THEN s[p]:='E'; END; (* IF *)
  199.  
  200.  v:=SL.strtod(SYS.ADR(s),end); DEC(end,SYS.ADR(s)); 
  201.  ok:=(end<LEN(s)) & (s[end]=0X); 
  202.  RETURN v; 
  203. END StrToReal;
  204.  
  205. (************************************************************************************************************************)
  206. BEGIN (* Str *)
  207.  NEW(nullCh,1); nullCh[0]:=0X; 
  208.  HexDigits:="0123456789ABCDEF";
  209. END Str.
  210.