IMPLEMENTATION MODULE Conversions;

IMPORT SYSTEM;
IMPORT String;

INLINE
  %#include <errno.h>
  %#include <stdlib.h>
  %#include <string.h>
  %#include <ctype.h>
  %#include <assert.h>
  END;

---------------------------------------
  ONCE CLASS IntConversions;

    METHOD IntToString (i, Width: INTEGER): ARRAY OF CHAR;
      BEGIN
      ASSERT Width < 40;
      INLINE
        %{  
        %   int eff_len = 0;
        %   char buffer[42], *p;
        %
        %   sprintf(buffer, "%40ld", Y_i);
        %   p = &(buffer[39]);
        %   assert(!buffer[40]);
        %   while (*p != ' ')
        %     {    
        %       eff_len++;
        %       p--;
        %     }
        %   if (eff_len <= Y_Width)
        %     Y_RESULT = new_string(buffer+40 - Y_Width);
        %    else
        %     Y_RESULT = new_string(p+1);
        %}
        END;
      END IntToString;                 
      
    METHOD IntToAnyString (i, Width, Base: INTEGER): ARRAY OF CHAR;
      VAR
        j, Pos, ResultingWidth: INTEGER;
        TheChars, TheBuff: ONCE ARRAY OF CHAR;
        Negative: BOOLEAN;
        TheValue: INTEGER;
      CONST
        BufSize = 32;
      BEGIN                           
      ASSERT Base > 1;
      ASSERT Base <= MaxBase; 
      IF i = 0 THEN
        RESULT := "0";
       ELSE
        IF TheChars = VOID THEN
          TheChars := "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
          ASSERT TheChars.SIZE = MaxBase;
          TheBuff.CREATE(BufSize);
          END;           
        IF i < 0 THEN
          TheValue := -i;
          Negative := TRUE;
         ELSE
          TheValue := i;
          END;
        Pos := BufSize - 1;
        WHILE TheValue > 0 DO
          TheBuff[Pos] := TheChars[TheValue MOD Base];
          TheValue := TheValue / Base;
          Pos := Pos - 1;
          END;
        IF Negative THEN
          TheBuff[Pos] := '-';
          Pos := Pos - 1;
          END;            
        j := Pos;
        WHILE j >= 0 DO
          TheBuff[j] := ' ';
          j := j - 1;
          END;      
        Pos := Pos + 1;           
        ASSERT TheBuff[Pos] <> ' ';
        ASSERT TheBuff[Pos-1] = ' ';
        ResultingWidth := BufSize - Pos;
        IF Width = 0 THEN
          RESULT := TheBuff.SLICE (Pos, ResultingWidth);
         ELSIF Width < ResultingWidth THEN
          RESULT.CREATE (Width);
          FOR k := 0 TO Width - 1 DO
            RESULT[k] := '?';
            END;
         ELSE
          RESULT := TheBuff.SLICE (BufSize - Width, Width);
          END;
        END;    
      DEBUG
        FOR k := 0 TO RESULT.SIZE - 1 DO
          ASSERT RESULT[k] <> SYSTEM.CHR(0);
          END;
        END;
      END IntToAnyString;

    METHOD IntToHexString (i, Width: INTEGER): ARRAY OF CHAR;
      BEGIN
      RESULT := IntToAnyString (i, Width, Base := 16);
      END IntToHexString;

      
    METHOD IntToBinString (TheInt, Width: INTEGER): ARRAY OF CHAR;
      VAR
         n : INTEGER;
      BEGIN
      n := TheInt;
      RESULT.CREATE (SYSTEM.BitsPerInt);
      FOR i := 0 TO RESULT.SIZE-1 DO
        RESULT [i] := ' ';
        END;
      FOR i := SYSTEM.BitsPerInt TO 1 BY -1 DO
        IF (n MOD 2) = 0 THEN
          RESULT [i-1] := '0';
         ELSE
          RESULT [i-1] := '1';
          END;
        n := n / 2;  
        END;
      IF Width = 0 THEN
        IF TheInt <= 0 THEN
          RESULT := '0';
         ELSE
          RESULT := String.Right (RESULT, String.Pos (RESULT, '1'));
          END;
       ELSE
        RESULT := String.Right (RESULT, Width);
        END;  
      END IntToBinString;
      
    VAR
      TheErrorCode: INTEGER;
      TheParsed: INTEGER;

    METHOD ErrorCode: INTEGER;
      BEGIN
      RESULT := TheErrorCode;
      END ErrorCode;

----------------------------------------------
-- patched by bernard
-- in order to implement the Parsed method, one must use
-- strtol instead of atoi
-- the former allows us to know where the conversion ended
-------------------------------------------------      
    METHOD StringToInt (a: ARRAY OF CHAR): INTEGER;
      VAR
        ECode, Pars: INTEGER;
      BEGIN
      IF a = VOID THEN
        TheParsed := 0;
        RESULT := 0;
        TheErrorCode := 0;
       ELSE
        ASSERT a <> VOID;
----------------------------------------------------------------      
-- it is necessary to set the C error code to zero because
-- this is never done by the library functions themselves       
----------------------------------------------------------------
        INLINE
          %{
          %  char *p, *q;
          %  errno = 0;
          %  p = (char *)Y_a;
          %  Y_RESULT = strtol(p, &q, 10);
          %  Y_ECode = errno;
          %  Y_Pars = q - p;
          %}
          END;     
        TheErrorCode := ECode;
        TheParsed := Pars;
        END;
      END StringToInt;

    METHOD HexStringToInt(a: ARRAY OF CHAR): INTEGER;
      VAR
        Ok: BOOLEAN;
         Code: INTEGER;
      BEGIN
      Ok := TRUE;
      FOR i := 0 TO a.SIZE - 1 WHILE Ok DO
        CASE a[i] OF
          'a' TO 'f':
            Code := 10 + SYSTEM.ORD(a[i]) - SYSTEM.ORD('a');
            END;
          'A' TO 'F':
            Code := 10 + SYSTEM.ORD(a[i]) - SYSTEM.ORD('A');
            END;
          '0' TO '9':
            Code := SYSTEM.ORD(a[i]) - SYSTEM.ORD('0');
            END;
         ELSE
          Ok := FALSE;
          END;
        IF Ok THEN
          TheParsed := i;
          RESULT := 16 * RESULT + Code;
          END;
        END;
      END HexStringToInt;

    METHOD Parsed: INTEGER;
      BEGIN
      RESULT := TheParsed;
      END Parsed;

  END IntConversions;

---------------------------------------
  ONCE CLASS RealConversions;
    METHOD RealToString (r: REAL;
                         Width,
                         Decimals: INTEGER): ARRAY OF CHAR;
      VAR
        Dec: INTEGER;                        
      BEGIN
      ASSERT Width < 58;
      ASSERT (Width = 0) OR (Width > Decimals);     
      Dec := Decimals;
      IF Width <> 0 THEN
        INLINE
          % {
          %   char temp[60], temp2[60];
          %   sprintf (temp, "%%%ld.%ldf", Y_Width, Y_Dec);
          %   sprintf (temp2, temp, Y_r);
          %   Y_RESULT = new_string (temp2);
          % }
          END;
       ELSE   
        INLINE
          % {
          %   char * p;
          %   char temp[60];
          %
          %   sprintf (temp, "%50.18f", Y_r);
          %   p = &temp [strlen (temp)-1];
          %   while ((p >= temp) && (*p == '0') && (*(p-1) != '.'))
          %      *p-- = 0;
          %   p = temp;
          %   while (*p == ' ')
          %      p++;
          %   Y_RESULT = new_string (p);
          % }
          END;
        END;
      END RealToString;

    VAR
      TheErrorCode: INTEGER;
      TheParsed: INTEGER;
      
    METHOD ErrorCode: INTEGER;
      BEGIN
      RESULT := TheErrorCode;
      END ErrorCode;

----------------------------------------------
-- patched by bernard
-- in order to implement the Parsed method, one must use
-- strtod instead of atof
-- the former allows us to know where the conversion ended
-------------------------------------------------      
    METHOD StringToReal (a: ARRAY OF CHAR): REAL;
      VAR
        ECode, Pars: INTEGER;
      BEGIN
      ASSERT a <> VOID;
-----------------------------------------------------------------------      
-- it is necessary to set the C error code to zero because
-- this is never done by the library functions themselves       
-----------------------------------------------------------------------
      INLINE
        %{
        %  char *p, *q;
        %  errno = 0;
        %  p = (char *)Y_a;
        %  Y_RESULT = strtod(p, &q);
        %  Y_ECode = errno;
        %  Y_Pars = q-p;
        %}
        END;
      TheErrorCode := ECode;
      TheParsed := Pars;
      END StringToReal;

    METHOD Parsed: INTEGER;
      BEGIN
      RESULT := TheParsed;
      END Parsed;

  END RealConversions;
-----------------------------------------
  CLASS PatternMapper;
    VAR
      ValueTable: ARRAY OF ARRAY OF CHAR;

    REDEFINE METHOD CREATE;
      BEGIN
      ValueTable.CREATE(SYSTEM.ORD('Z') - SYSTEM.ORD('A') + 1);
      END CREATE;

    METHOD Index (Code: CHAR): INTEGER;
      POST
        NO_CHANGE;
      VAR
        Ch: CHAR;
      BEGIN
      Ch := SYSTEM.UCASE (Code);
      ASSERT SYSTEM.IsLetter(Ch);
      CASE Ch OF
        'A' TO 'Z':
          RESULT := SYSTEM.ORD(Ch) - SYSTEM.ORD('A');
          END;
        END;
      ASSERT RESULT >= 0;
      ASSERT RESULT < ValueTable.SIZE;
      END Index;

    METHOD Associate (Code: CHAR; 
                      Value: ARRAY OF CHAR);
      BEGIN  
      ValueTable [Index(Code)] := Value;
      ASSERT AssocValue(Code) = Value;
      END Associate;
  
    METHOD AssocValue(Code: CHAR): ARRAY OF CHAR;
      BEGIN
      RESULT := ValueTable [Index(Code)];
      END AssocValue;
  
    METHOD Map (Pattern: ARRAY OF CHAR): ARRAY OF CHAR;
      VAR
        Pos, NewPos, PatLen: INTEGER;
        Seq, Data: ARRAY OF CHAR;
        PleaseTruncate, 
        PleaseForce, 
        PleaseCheckDot,
        PleaseCheckSlash,
        PleaseCheckBackSlash,
        ConvertToUpperCase, 
        ConvertToLowerCase: BOOLEAN;
        Width: INTEGER;

        METHOD ExtractEscapeSeq (FromPos: INTEGER): ARRAY OF CHAR;
          VAR
            NewPos: INTEGER;
          BEGIN
          ASSERT Pattern [FromPos] = EscapeChar;
          NewPos := FromPos + 1;
          WHILE (NewPos < PatLen) AND 
                  ((SYSTEM.UCASE(Pattern[NewPos]) < 'A') OR
                   (SYSTEM.UCASE(Pattern[NewPos]) > 'Z')) AND
                  (Pattern[NewPos] <> EscapeChar) DO
            NewPos := NewPos + 1;
            END;
          IF NewPos < PatLen THEN
            NewPos := NewPos + 1;
            END;
          RESULT := Pattern.SLICE (FromPos, NewPos - FromPos);
          END ExtractEscapeSeq;

      BEGIN
      PatLen := Pattern.SIZE;
      WHILE Pos < PatLen DO
        NewPos := Pos;
        WHILE (NewPos < PatLen) AND (Pattern[NewPos] <> EscapeChar) DO
          NewPos := NewPos + 1;
          END;
        IF NewPos <> Pos THEN
          RESULT := RESULT + Pattern.SLICE (Pos, NewPos - Pos);
          Pos := NewPos;
          END;
        IF Pos < PatLen THEN
          ASSERT Pattern [Pos] = EscapeChar;
          Seq := ExtractEscapeSeq (Pos);
          Pos := Pos + Seq.SIZE;
          ConvertToLowerCase := FALSE;
          ConvertToUpperCase := FALSE;  
          PleaseCheckDot := FALSE;
          PleaseCheckSlash := FALSE;
          PleaseCheckBackSlash := FALSE;
          Width := 0;
          PleaseForce := FALSE;
          PleaseTruncate := FALSE;
          FOR i := 0 TO Seq.SIZE - 1 DO
            CASE Seq[i] OF
              '-':
                ConvertToLowerCase := TRUE;
                END;
              '+':
                ConvertToUpperCase := TRUE;
                END;
              '<':
                PleaseTruncate := TRUE;
                END;
              '/':
                PleaseCheckSlash := TRUE;
                END;
              '\':
                PleaseCheckBackSlash := TRUE;
                END;
              '.':
                PleaseCheckDot := TRUE;
                END;
              '=':
                PleaseForce := TRUE;
                END;
              '0' TO '9':
                Width := (10 * Width) + SYSTEM.ORD(Seq[i]) - SYSTEM.ORD('0');
                END;
             ELSE
              -- Do nothing...
              END;
            END;
          PleaseTruncate := PleaseTruncate OR ((Width > 0) AND NOT PleaseForce);
          IF Seq[Seq.SIZE - 1] = EscapeChar THEN
            RESULT := RESULT + EscapeChar;
           ELSE
            Data := AssocValue (Seq[Seq.SIZE - 1]);
            IF Data <> VOID THEN
              IF ConvertToLowerCase THEN
                Data := String.LowerCase (Data);
                END;
              IF ConvertToUpperCase THEN
                Data := String.UpperCase (Data);
                END;
              IF PleaseCheckSlash AND (Data.SIZE > 0) AND 
                                      (Data[Data.SIZE -1] <> '/') THEN
                Data := Data + '/';                                   
               ELSIF PleaseCheckBackSlash AND (Data.SIZE > 0) AND 
                                      (Data[Data.SIZE -1] <> '\') THEN
                Data := Data + '\';                                   
               ELSIF PleaseCheckDot AND (Data.SIZE > 0) AND 
                                      (Data[Data.SIZE -1] <> '.') THEN
                Data := Data + '.';                                   
                END;
              IF Width > 0 THEN
                IF PleaseTruncate AND (Data.SIZE > Width) THEN                
                  Data := Data.SLICE (0, Width);
                  END;
                IF PleaseForce THEN                
                  WHILE Data.SIZE < Width DO
                    Data := Data + ' ';
                    END;
                  END;
                END; 
              RESULT := RESULT + Data;
              END;
            END;
          END;
        END;
      END Map;

  END PatternMapper;

END Conversions;
