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

PROGRAM DECBINCNV;

USES crt;

{//////////////////////////////////////////////////////////////////////////////
  AUTHOR    : Lo Ching Chin James (950208778)
  COURSE    : CIS101 - Introduction to Computer and Computer Programming
  ASSIGN    : CW3A.PAS
  DATE      : 20 Nov 1997
  COPYRIGHT : JAMES LO NOVEMBER 1997, HONG KONG

  This program provides function to :

  1. Convert a positive or negative integer into binary string.
  2. Convert a binary string into a positive or negative integer.
  3. Convert a real number to binary string.
  4. Convert a binary string to real number.

  Input :

  User select appropriate options and input data such as no. of bytes, binary
  strings or integers to perform conversion.

  Output :

  Systems will display the results depending on what task has been performed.

///////////////////////////////////////////////////////////////////////////////}


CONST

    i_LowLimit       = 1;  { Define the lower limit of choice value }
    i_HighLimit      = 5;  { Define the higher limit of the choice value }
    i_1Byte          = 1;  { Define the value for 1 byte }
    i_2Byte          = 2;  { Define the value for 2 bytes }
    i_NoOfBit        = 8;  { Define the number of bits per byte }
    i_Base2          = 2;  { Define base 2 value }
    i_8ExpStartBit   = 2;  { Define the starting bit of exponent real num 8 bit }
    i_8ExpEndBit     = 4;  { Define the ending bit of exponent real num 8 bit }
    i_8ManStartBit   = 5;  { Define the starting bit mantissa of real num 8 bit }
    i_8ManEndBit     = 8;  { Define the ending bit mantissa of real num 8 bit }
    i_16ExpStartBit  = 2;  { Define the starting bit exponent of real num 16 bit }
    i_16ExpEndBit    = 6;  { Define the ending bit exponent of real num 16 bit }
    i_16ManStartBit  = 7;  { Define the starting bit mantissa of real num 16 bit }
    i_16ManEndBit    = 16; { Define the ending bit mantissa of real num 16 bit }
    i_8BitExpInd     = 4;  { Define the 8 bit indicator }
    i_16BitExpInd    = 16; { Define the 16 bit indicator }
    r_8posbinary     = 7.5;  {Define real number limit for 8 bit}
    r_16posbinary    = 32736.0; {Define real number limit for 16 bit}
    i_MultipleOfByte = 2;    {Define the mutiple of bits per byte}
    s_ZeroString     = '0';  {Define '0' string}
    s_OneString      = '1';  {Define '1' string}
    i_OKIOResult     = 0;    {Define good I/O result}
    s_Space          = ' ';  {Define space value}
    r_OneHalf        = 0.5;  {Define one half value}
    i_NegativeOne    = -1;
    i_PositiveOne    =  1;

TYPE

    bit_string       = ARRAY[1..i_NoOfBit * i_MultipleOfByte] OF Char;

VAR

    s_Response     : char;       {Define a char for response}
    i_Choice       : integer;    {Define choice variable}
    i_Byte,i_Bit   : integer;    {Define byte and bit variable}
    i_integer      : Longint;    {Define variable for integer input}
    r_RealNum      : Real;       {Define variable for real number input }
    s_string       : bit_string; {Define variable for converted string}
    s_dummy        : char;       {Define dummy variable for enter key}
    i_LowRange,
    i_HighRange    : LONGINT;    {Define variable for hi and low integers}
    r_LowRange,
    r_HighRange    : REAL;       {Define variable for hi and low real number}


{////////////////////////////////////////////////////////////////////////////
 TRIM() - this function trims trailing space.
////////////////////////////////////////////////////////////////////////////}
FUNCTION TRIM(inStr:STRING):STRING;

BEGIN

    WHILE (inStr[LENGTH (inStr)] = ' ') DO
        inStr := COPY (inStr, 1, LENGTH (inStr ) - 1);
    WHILE (inStr[1] = ' ') DO
          DELETE (inStr, 1, 1);
    TRIM := inStr

END; {TRIM}


{/////////////////////////////////////////////////////////////////////////////
 Press any key to continue procedure
/////////////////////////////////////////////////////////////////////////////}
PROCEDURE PRESSKEY;

BEGIN

    WRITE('Press any key to continue ...');

END;


{/////////////////////////////////////////////////////////////////////////////
 Raise X to power Y
/////////////////////////////////////////////////////////////////////////////}
FUNCTION RAISEPOWER(base,exponent:INTEGER): LONGINT;

VAR

     i_temp, i : LONGINT;

BEGIN

     i_temp := 1;

     FOR i := 1 TO exponent DO
         i_temp := i_temp * i_base2;

     RAISEPOWER := i_temp;

END; {RAISEPOWER}


{////////////////////////////////////////////////////////////////////////////
 Print bit string to screen
////////////////////////////////////////////////////////////////////////////}
PROCEDURE BIT_STRING_PRINT(VAR b:bit_string; nbit:INTEGER);

VAR

     i    : INTEGER;

BEGIN

     FOR i := 1 TO nbit DO
         WRITE (b[i]);

END; {BIT_STRING_PRINT}


{////////////////////////////////////////////////////////////////////////////
 Set bit value of '0' or '1' based on passed parameter value
////////////////////////////////////////////////////////////////////////////}
PROCEDURE BIT_STRING_SETBIT(VAR b:bit_string; nth:INTEGER; value:INTEGER);

VAR

     s  : STRING[1];

BEGIN

     STR(value,s);
     b[nth] := s[1];

END; {BIT_STRING_SETBIT}


{////////////////////////////////////////////////////////////////////////////
 Fill in '0's to the trailing space
////////////////////////////////////////////////////////////////////////////}
PROCEDURE BIT_STRING_ZERO(VAR b:bit_string; i_frvalue:INTEGER; i_tovalue: INTEGER);

VAR

     i : integer;

BEGIN

      FOR i := i_frvalue TO i_tovalue DO
           b[i] := s_ZeroString;

END; {BIT_STRING_ZERO}


{////////////////////////////////////////////////////////////////////////////
 Reverse bit string order e.g. '00100000' --> '00000100'
////////////////////////////////////////////////////////////////////////////}
PROCEDURE BIT_STRING_REVERSE(VAR b:bit_string; value:INTEGER);

VAR

    i,j        : INTEGER;
    tmp_string : bit_string;

BEGIN

     j := 0;
     FOR i := value DOWNTO 1 DO   { Reverse the order }
         BEGIN
            INC(j);
            tmp_string[j] := b[i];
         END;

     FOR i := 1 TO value DO       { Move from temp array to actual array }
         BEGIN
            b[i] := tmp_string[i];
         END;

END; {BIT_STRING_REVERSE}


{////////////////////////////////////////////////////////////////////////////
 2's complement routine e.g. '00100000' --> '11100000'
////////////////////////////////////////////////////////////////////////////}
PROCEDURE BIT_STRING_2COM(VAR b:bit_string; nbit:INTEGER);

VAR

    b_finish   : boolean;
    j, i       : INTEGER;

BEGIN

      FOR i := nbit DOWNTO 1 DO  { Reverse the bit '0' to '1' or vice versa }
          IF b[i] = s_ZeroString THEN
             b[i] := SUCC(b[i])
          ELSE
             b[i] := PRED(b[i]);

      b_finish  := FALSE;
      j := nbit;

      REPEAT

         BEGIN
            IF b[j] = s_ZeroString THEN
               BEGIN
                   b[j] := SUCC(b[j]);
                   b_finish := TRUE;    { Exit from this loop }
               END
            ELSE
               BEGIN
                   b[j] := PRED(b[j]);
               END;
            DEC(j);                     { Decrease from right to left }
         END;

      UNTIL b_finish;

END; {BIT_STRING_2COM}


{////////////////////////////////////////////////////////////////////////////
 To copy the string into the array
////////////////////////////////////////////////////////////////////////////}
PROCEDURE BIT_STRING_COPY(s_inString        : STRING;
                         i_ExpStart,i_ExpEnd: INTEGER;
                          VAR b             : bit_string);


VAR

      j, i : INTEGER;

BEGIN

      j := 1 ;
      FOR i := i_ExpStart TO i_ExpEnd DO
          BEGIN
             b[i] := s_inString[j];
             INC(j);
          END

END; {BIT_STRING_COPY}


{////////////////////////////////////////////////////////////////////////////
 Routine to chop off zeros in extreme left in order to get the first 1
////////////////////////////////////////////////////////////////////////////}
PROCEDURE STRING_CHOPOFF_ZERO(VAR s_inString: STRING;
                              VAR i_expvalue: INTEGER);

VAR

      tmp_string : String;
      i, j       : INTEGER;

BEGIN

       i := 1;
       i_expvalue := 0;
       tmp_string := '';

       WHILE s_inString[i] <> s_OneString DO
         BEGIN
              INC(i_expvalue);
              INC(i);
         END;

       j := i;
       tmp_string := COPY(s_instring, j, LENGTH(s_inString) - i + 1);
       s_inString := tmp_String;

END;


{////////////////////////////////////////////////////////////////////////////
 Calculate no. of bits based on byte number
////////////////////////////////////////////////////////////////////////////}
FUNCTION GETBITNO(i_byte:INTEGER): INTEGER;

BEGIN

     IF i_byte = 1 THEN
        GETBITNO := i_NoOFBit
     ELSE
        GETBITNO := i_NoOFBit * i_MultipleOfByte;

END; {GETBITNO}


{////////////////////////////////////////////////////////////////////////////
 Capture number of bytes
////////////////////////////////////////////////////////////////////////////}
PROCEDURE GETBYTENO(i_1B,i_2B          : INTEGER;
                    VAR i_RByte, i_RBit: INTEGER);

VAR

      i_Number,i_X,i_Y   : INTEGER;

BEGIN

      REPEAT

            GOTOXY(1,11);
            WRITE  ('Enter how many bytes ','(1 Byte = ',i_NoOfBit, ' bits) (',i_1B:1,' or ',i_2B:1,') : ');
            i_X := WHEREX;
            i_Y := WHEREY;
            {$I-}
            TEXTCOLOR(YELLOW);
            READLN (i_Number);
            TEXTCOLOR(WHITE);
            {$I+}
            IF (IORESULT <> i_OKIOResult) OR (i_Number < i_1B) OR (i_Number > i_2B) THEN
               BEGIN
                 GOTOXY(i_X,i_Y);
                 CLREOL;
               END
            ELSE
               BEGIN
                 i_RByte := i_Number;
                 i_RBit  := GETBITNO(i_Number);
               END

      UNTIL (IORESULT = i_OKIOResult) AND (i_Number >= i_1B) AND (i_Number <= i_2B)

END; {GETBYTENO}


{/////////////////////////////////////////////////////////////////////////////
 Get user input a integer number
/////////////////////////////////////////////////////////////////////////////}
PROCEDURE GETNUMBER(i_Low,i_High  : INTEGER;
                    VAR i_Number  : LONGINT;
                    VAR b_OverFlow: BOOLEAN);

VAR

     i_X,i_Y, i_IORESULT   : INTEGER;

BEGIN

      REPEAT

          b_OverFlow := FALSE;
          GOTOXY(1,12);
          WRITE  ('Enter a positive or negative integer: ');
          i_X := WHEREX;
          i_Y := WHEREY;
          {$I-}
          TEXTCOLOR(YELLOW);
          READLN (i_Number);
          TEXTCOLOR(WHITE);
          {$I+}
          i_ioresult := IORESULT;
          IF (i_Number < i_Low) OR (i_Number > i_High) THEN
             BEGIN
                b_OverFlow := TRUE;    { Set this flag to true for overflow }
                GOTOXY(1,13);
                TEXTCOLOR(LIGHTRED+BLINK);
                WRITELN('Error: Data overflow. Range is ',i_Low, ' to ', i_High,' for ',i_Byte, ' byte(s).');
                TEXTCOLOR(WHITE);
             END;
          IF (i_IORESULT <> i_OKIOResult) THEN
             BEGIN
                GOTOXY(1,13);
                TEXTCOLOR(LIGHTRED+BLINK);
                WRITE('Error: Accepts only positive or negative integer.');
                TEXTCOLOR(WHITE);
                s_dummy := READKEY;
                GOTOXY(1,13);
                CLREOL;
                GOTOXY(i_X,i_Y);
                CLREOL;
             END;
      UNTIL (i_IORESULT = i_OKIOResult)


END; {GETNUMBER}


{/////////////////////////////////////////////////////////////////////////////
 Get user input a integer number
/////////////////////////////////////////////////////////////////////////////}
PROCEDURE GETREALNUM(r_Low,r_High  : REAL;
                     VAR r_Number  : REAL;
                     VAR b_OverFlow: BOOLEAN);

VAR

     i_X,i_Y, i_IORESULT   : INTEGER;

BEGIN

      REPEAT

          b_OverFlow := FALSE;
          GOTOXY(1,12);
          WRITE  ('Enter a positive or negative real number : ');
          i_X := WHEREX;
          i_Y := WHEREY;
          {$I-}
          TEXTCOLOR(YELLOW);
          READLN (r_Number);
          TEXTCOLOR(WHITE);
          {$I+}
          i_IORESULT := IORESULT;
          IF (r_Number < r_Low) OR (r_Number > r_High) THEN
             BEGIN
                b_OverFlow := TRUE;
                GOTOXY(1,13);
                TEXTCOLOR(LIGHTRED+BLINK);
                WRITELN('Error: Data overflow, range is ',r_Low:5:4,' to ',r_High:5:4,' for ',i_Byte, ' byte(s).');
                TEXTCOLOR(WHITE);
             END;

          IF (i_IORESULT <> i_OKIOResult) THEN
             BEGIN
                GOTOXY(1,13);
                WRITE('Error: Accepts only real number.');
                s_dummy := READKEY;
                GOTOXY(1,13);
                CLREOL;
                GOTOXY(i_X,i_Y);
                CLREOL;
             END;

      UNTIL (i_IORESULT = i_OKIOResult)

END; {GETREALNUM}


{//////////////////////////////////////////////////////////////////////////////
 Process calculate integer to binary
//////////////////////////////////////////////////////////////////////////////}
PROCEDURE CALINTBIN(i_Num: LONGINT; i_Bit :INTEGER; VAR b:bit_string;
                    b_OFFlag:BOOLEAN);

VAR

       i_quotient,i_remainder, i, j, k  : INTEGER;
       s                                : String[1];
       tmp_string, bin_string           : bit_string;
       i_absnum                         : LONGINT;

BEGIN

       FOR j := 1 TO i_bit DO    { Initialize array }
          BEGIN
             tmp_string[j] := s_Space;
             bin_string[j] := s_Space;
          END;

       i := 0;
       i_absnum := ABS(i_num);
       WHILE (i_absnum <> 0) DO   { IF number is 10, the base 2 is 0101 }
          BEGIN
             i_quotient := i_absnum DIV i_MultipleOfByte;
             i_remainder:= i_absnum MOD i_MultipleOfByte;
             i_absnum := i_quotient;
             INC(i);
             BIT_STRING_SETBIT(tmp_string,i,i_remainder);
          END;

       k := i + 1;   { Should add 1 here for next bit }
       BIT_STRING_ZERO(tmp_string, k, i_bit); { Fill in '0' }

       { At this point, the bit pattern is filled with '0's but in reverse
         order.  e.g.  4 ---> '00100000', should be '00000100'.
         So, we have to reverse it. }

       BIT_STRING_REVERSE(tmp_string,i_bit); { Reverse the bit pattern }

       bin_string := tmp_string;
       { At this point, the bit pattern is in proper order }

       IF i_num < 0  THEN   { Input number is a negative number }
          BEGIN
             BIT_STRING_2COM(bin_string,i_bit);  {Get the 2's complement}
             b := bin_string;
          END
       ELSE
          b := bin_string;

      IF b_OFFlag THEN   {If the number inputed is overflow }
         IF i_num < 0 THEN
            b[1] := s_OneString   {Set to '1'}
         ELSE
            b[1] := s_ZeroString; {Set to '0'}


END; {CALINTBIN}


{/////////////////////////////////////////////////////////////////////////////
 Binary to decimal
/////////////////////////////////////////////////////////////////////////////}
FUNCTION BINTODEC (s_binary:STRING):INTEGER;

VAR

     j              : integer;  { Define counter }
     i_value        : LONGINT;  { Define converted binary to decimal value }

BEGIN

     i_value := 0;

     FOR j := LENGTH(TRIM(s_binary)) DOWNTO 2 DO
         { Not downto 1 because 1 is a sign bit }
         BEGIN
              IF s_binary[j] = s_OneString THEN
                  i_value := i_value + TRUNC(EXP(((LENGTH(TRIM(s_binary)) - j) * LN(i_Base2) )))
              ELSE
                  i_value := i_value + 0;
         END;

     IF s_binary[1] = s_OneString THEN    {Input number is a negative value}
        BINTODEC := i_value - RAISEPOWER(i_Base2,i_bit - i_PositiveOne)
     ELSE
        BINTODEC := i_value;

END; {BINTODEC}


{/////////////////////////////////////////////////////////////////////////////
 Binary to integer routine
/////////////////////////////////////////////////////////////////////////////}
PROCEDURE BINTOINT;

VAR

     i,j,i_X,i_Y      : integer;
     b_okay           : boolean;
     s_binary         : String;

BEGIN

     GETBYTENO(i_1Byte,i_2Byte,i_Byte,i_Bit);

     REPEAT

         BEGIN

           b_okay := TRUE;
           s_binary := '';
           GOTOXY(1,12);
           WRITE ('Please enter a binary string in ',i_Bit, ' bit format : ');
           i_X := WHEREX;
           i_Y := WHEREY;
           CLREOL;
           TEXTCOLOR(YELLOW);
           READLN (s_binary);
           TEXTCOLOR(WHITE);
           FOR i := LENGTH(TRIM(s_binary)) DOWNTO i_PositiveOne DO
               IF NOT (s_binary[i] = s_ZeroString) AND NOT (s_binary[i] = s_OneString) THEN
                   BEGIN
                        b_okay := FALSE;
                        GOTOXY(i_X,i_Y);
                        CLREOL;
                   END
         END

     UNTIL b_okay AND (LENGTH(TRIM(s_binary)) = (i_Bit));

     WRITE  ('"', s_binary, '" binary string represents integer value : ');
     TEXTCOLOR(YELLOW);
     WRITE(BINTODEC(s_binary));
     TEXTCOLOR(WHITE);
     WRITELN('.');

END; {BINTOINT}


{////////////////////////////////////////////////////////////////////////////
 Integer to binary conversion
////////////////////////////////////////////////////////////////////////////}
PROCEDURE INTTOBIN;

VAR

      b_OFlowFlag : BOOLEAN;

BEGIN

      GETBYTENO(i_1Byte,i_2Byte,i_Byte,i_Bit);
      i_LowRange  := RAISEPOWER(i_Base2,i_Bit - i_PositiveOne) * i_NegativeOne;
      i_HighRange := RAISEPOWER(i_Base2,i_Bit - i_PositiveOne) - i_PositiveOne;
      GETNUMBER(i_LowRange,i_HighRange,i_Integer,b_OFlowFlag);
      WRITE (i_integer,' will be stored in ',i_byte, ' byte(s) as : ');
      WRITE('"');
      TEXTCOLOR(YELLOW);
      CALINTBIN(i_integer,i_Bit,s_string,b_OFlowFlag);  { Integer to binary routine }
      BIT_STRING_PRINT(s_string,i_bit);   { Print binary string }
      TEXTCOLOR(WHITE);
      WRITE('".');
      WRITELN;

END; {INTTOBIN}


{///////////////////////////////////////////////////////////////////////////
 Calculate exponent value
///////////////////////////////////////////////////////////////////////////}
FUNCTION CALEXP(s:Char; p:INTEGER):REAL;

VAR

      r_value   : REAL;
      i_errcode : INTEGER;
      i,j       : INTEGER;

BEGIN

      VAL(s,i,i_errcode);
      r_value := 1.0;

      FOR j := 1 TO p DO
          r_value := r_value * r_OneHalf;

      CALEXP := r_value * i;

END;  {CALEXP}


{/////////////////////////////////////////////////////////////////////////////
 Calculate the exponent value of the bit string to real numbers
/////////////////////////////////////////////////////////////////////////////}
FUNCTION CALEXPVAL(s_bitchar:Char; i: INTEGER): INTEGER;

VAR

      i_bitcharval,i_expval,i_errcode : INTEGER;

BEGIN

      i_expval := 0;
      i_bitcharval := 0;
      VAL(s_bitchar,i_bitcharval,i_errcode);
      i_expval := TRUNC(EXP(i * LN (i_base2)));

      CALEXPVAL := i_bitcharval * i_expval;
      { bit value (e.g. '1' -> 1 * 2 ^ i value }

END; {CALEXPVAL}


{/////////////////////////////////////////////////////////////////////////////
 Calculate exponent value of the bit string to real number
/////////////////////////////////////////////////////////////////////////////}
FUNCTION GETEXPVAL(s_binary:STRING;
                   i_start,i_end,i_expvalue:INTEGER):INTEGER;

VAR

      r_temp  : INTEGER;
      j,i     : INTEGER;

BEGIN

      r_temp := 0;
           j := 0;  {Starting point}

      FOR i:= i_end DOWNTO i_start DO

          BEGIN
             r_temp := r_temp + CALEXPVAL(s_binary[i],j);
             INC(j);
          END;

      GETEXPVAL := r_temp - i_expvalue;  { value of the exponent - 4 or 16 }

END; {GETEXPVAL}


{/////////////////////////////////////////////////////////////////////////////
 Calculate mantissa value of the bit string to real number
/////////////////////////////////////////////////////////////////////////////}
FUNCTION GETMANVAL(s_binary:STRING;i_start,i_end:INTEGER):REAL;

VAR

      r_temp  : REAL;
      j,i     : INTEGER;

BEGIN

      r_temp := 0.0;

      j := 1;
      FOR i:= i_start TO i_end DO
          BEGIN
               r_temp := r_temp + CALEXP(s_binary[i],j);
               INC(j);
          END;

      GETMANVAL := r_temp;

END;  {GETMANVAL}


{/////////////////////////////////////////////////////////////////////////////
 This function calculates parameter value in real type and return also in real
 type but in base 2
/////////////////////////////////////////////////////////////////////////////}
FUNCTION REMAINBASE2(r_fractionValue:REAL):STRING;

VAR

      s_base2value                        : STRING;
      r_temp, r_fraction                  : REAL;
      i, j, i_string, icode, i_divisor    : INTEGER;
      s_temp_string                       : String[1];
      s_string                            : String;

BEGIN

      r_fraction := r_fractionValue;
      i          := 0;
      s_string   := '';
      r_temp     := 0;

      REPEAT
           BEGIN
             r_temp        := r_fraction * i_MultipleOfByte;
             STR(TRUNC(r_temp),s_temp_string);
             s_string      := s_string + s_temp_string;
             r_fraction    := r_temp - TRUNC(r_temp);
             INC(i);
           END
      UNTIL r_fraction = 0.0;

      {At this point, the s_string contains e.g. 01 Base 2 for 0.25 value}
      s_base2value := s_string;
      REMAINBASE2 := s_base2value;

END;


{//////////////////////////////////////////////////////////////////////////////
 Process calculate integer to binary
//////////////////////////////////////////////////////////////////////////////}
PROCEDURE INTBASE2(i_Num: LONGINT;  VAR i_exponent:INTEGER;
                                    VAR bin_string:STRING);

VAR

       i_quotient,i_remainder, p,
       j, k, i_intBase2, icode          : INTEGER;
       s                                : String[1];
       tmp_string                       : String;
       i_absnum                         : LONGINT;

BEGIN

       i_exponent := 0;
       i_absnum := ABS(i_num);
       tmp_string := '';
       bin_string := '          '; 
       WHILE (i_absnum <> 0) DO
       { IF number is 10, the base 2 is 0101, if number is 0 then it will
         skip this part }
          BEGIN
             i_quotient := i_absnum DIV i_MultipleOfByte;
             i_remainder:= i_absnum MOD i_MultipleOfByte;
             i_absnum := i_quotient;
             STR(i_remainder,s);
             tmp_string := tmp_string + s;
             INC(i_exponent);
          END;

       { At this point, the string value in tmp_string is in reverse order
         so we have to reverse back it}

       IF ABS(i_num) <> 0 THEN
          BEGIN
              p := i_exponent;
              FOR j := 1 TO p DO
              BEGIN
                 bin_string[j] := tmp_string[p];
                 DEC(p);
              END
          END
       ELSE
          BEGIN
             i_exponent := 0;
             bin_string := s_ZeroString;
          END


END; {INTBASE2}


{/////////////////////////////////////////////////////////////////////////////
 Copy temporary bit string to the final bit string
/////////////////////////////////////////////////////////////////////////////}
PROCEDURE BIT_STRING_SETMAN(s_inString:STRING;
                            i_nBit    :INTEGER;
                            VAR b     :bit_string);

VAR

     i_StartBit, i_EndBit, i, j, k, q, p : INTEGER;

BEGIN

      IF i_nBit = i_NoOfBit THEN
         BEGIN
            i_StartBit := i_8ManStartBit ;
            i_EndBit   := i_8ManEndBit   ;
         END
      ELSE
         BEGIN
            i_StartBit := i_16ManStartBit ;
            i_EndBit   := i_16ManEndBit   ;
         END;

      j := i_EndBit - i_StartBit + 1;   { j refers to no. of bit for mantissa }
      k := i_StartBit;
      IF LENGTH(TRIM(s_inString)) > j THEN
         BEGIN
            WRITELN('Note: Round off error.');
            FOR i := 1 TO j DO    { How many times to fill the s_InString }
            BEGIN
               b[k] := s_InString[i];
               INC(k);
            END
         END
      ELSE
         FOR i := 1 TO LENGTH(TRIM(s_inString)) DO    { How many times to fill the s_InString }
         BEGIN
             b[k] := s_InString[i];
             INC(k);
         END;


      { If there is available space to fill in, we have to do the following
        routine, e.g. if the input is 16 bit the storage for 2.25 is like
        this for mantissa:
                    16 bit
        +-------------------------------+
        | | | | | | |1|0|0|1| | | | | | |
        +-------------------------------+
                     |       | | | | | | ----> these should be filled with '0'
                     +----Start of mantissa
      }

      q := k;
      p := LENGTH(TRIM(s_inString));

      IF p < (i_EndBit - i_StartBit + i_PositiveOne) THEN
      { To check whether any zero to fill }

         BEGIN
           BIT_STRING_ZERO(b,q,i_EndBit);
         END

END; {BIT_STRING_SETMAN}


{/////////////////////////////////////////////////////////////////////////////
 To set the bit string for exponent value
/////////////////////////////////////////////////////////////////////////////}
PROCEDURE BIT_STRING_SETEXP(i_exponent:INTEGER;
                            c_Sign    :CHAR;
                            i_Bit     :INTEGER;
                            VAR b     :bit_string);

VAR

    k, i, p, q, r, t, u, w, y, z, x, i_dummy : INTEGER;
    s_rtnstring,s_finalString, tmp_string    : STRING;

BEGIN

       s_finalstring := '';

       IF i_Bit = i_NoOfBit THEN
          BEGIN
             q := i_8BitExpInd;          { q is excess 4 }
             t := i_8ExpStartBit;
             u := i_8ExpEndBit;
             w := i_8ExpEndBit - i_8ExpStartBit;
          END
       ELSE
          BEGIN
             q := i_16BitExpInd;         { q in excess 16 }
             t := i_16ExpStartBit;
             u := i_16ExpEndBit;
             w := i_16ExpEndBit - i_16ExpStartBit;
          END;

       IF i_exponent = 0 THEN { Logically meant, no need to do with the exponent }
          BEGIN
              p := q;
              INTBASE2(p,i_dummy,s_rtnstring);
          END
       ELSE
          BEGIN
              IF c_Sign = '+' THEN
                 p := i_exponent + q
              ELSE
                 p := i_exponent * i_NegativeOne + q;
              INTBASE2(p,i_dummy,s_rtnstring);
          END;

       tmp_string := TRIM(s_rtnString);
       x := LENGTH(tmp_string);

       IF x < w + 1 THEN
          BEGIN
            y  := ( w + 1 ) - x;
            FOR z := 1 TO y DO
              s_finalString := s_finalString + s_ZeroString;
          END;

       s_finalString := s_finalString + tmp_string;

       {At this point, we have already the string for exponent side and ready
        to put it into the final bit string array }

       BIT_STRING_COPY(s_finalstring,t,u,b);

END; {BIT_STRING_SETEXP}


{///////////////////////////////////////////////////////////////////////////
 Real to bin
///////////////////////////////////////////////////////////////////////////}
PROCEDURE CALREALBIN (r_inputReal   :REAL;
                     i_Bit          :INTEGER;
                     b_OFFlag       :BOOLEAN;
                     VAR s_outstring:bit_string);

VAR

    r_RealNumInBase2 : REAL;
    r_ABSValNum      : REAL;
    r_remain         : REAL;
    s_remainBase2    : STRING;
    s_totvalBase2    : STRING;
    s_intBase2       : STRING;
    i_intBase2       : INTEGER;
    icode            : INTEGER;
    i_exponent       : INTEGER;
    i_expvalue       : INTEGER;
    i,ierrcode,j,k   : INTEGER;
    bin_string       : bit_string;
    i_totexpval,q    : INTEGER;
    i_dummy,i_loop   : INTEGER;
    c_Sign           : CHAR;

    { Fractional value in base 2, e.g. 6.25 (base 10) --> 110.01 (base 2) }

BEGIN

    r_ABSValNum   := ABS(r_inputReal);      { Get the absolute value}
    r_remain      := r_ABSValNum - TRUNC(r_ABSValNum); { e.g. 6.25 - 6.0 = .25 }

    IF r_ABSValNum < r_OneHalf THEN  { Check the inputed value in absolute value }
       c_Sign := '-'
    ELSE
       c_Sign := '+';

    s_remainBase2 := REMAINBASE2(r_remain);    { 0.25 Base 10 --> '01' }
    INTBASE2(TRUNC(r_ABSValNum), i_exponent, s_intBase2);  {6 Base 10 --> '110' }
    s_intBase2 := TRIM(s_intBase2);

    IF s_intBase2 = s_ZeroString THEN       { if the integer part is 0 }
       s_totvalBase2 := s_remainBase2 { '01' = '01' }
    ELSE
       s_totvalBase2 := s_intBase2 + s_remainBase2; { '110'+'01' = '11001' }

    {At this point, there are cases which the s_totvalbase2 string will
     start with '0....'. e.g. 0.4 base10 with be 0.01100110011... in base 2,
     so we must chop off the first 0 until the first bit is 1}

    STRING_CHOPOFF_ZERO(s_totvalBase2, i_expvalue);
    { i_expvalue is exponent to the right }

    FOR i := 1 TO i_Bit DO            { Initialize the final bit string }
       bin_string[i] := s_Space;

    IF i_exponent = 0 THEN
       i_exponent := i_expvalue;

    BIT_STRING_SETMAN(s_totvalBase2,i_Bit,bin_string);
    { To copy the bit string value of mantissa e.g. 6.25 ,
      the mantissa is '11001'}

    BIT_STRING_SETEXP(i_exponent,c_Sign,i_Bit,bin_string);
    { To set the exponent bit string e.g. 6.25 , the exponent bit string is
      '111' because '111' is 3 in excess 4 notation }

    { So, at this point, the bit string for 6.25 is '01111100' for 8 bit or
      '0100111100000000' for 16 bit }

    IF r_inputReal < 0 THEN
       bin_string[1] := s_OneString
    ELSE
       bin_string[1] := s_ZeroString;

    IF b_OFFlag THEN
       WRITELN('Note: The inputed real value has been overflowed.');

    s_outstring := bin_string;

END; {CALREALBIN}


{/////////////////////////////////////////////////////////////////////////////
 Convert real number to binary string
/////////////////////////////////////////////////////////////////////////////}
PROCEDURE REALTOBIN;

VAR

      r_realposval, r_realnegval  : REAL;
      b_OverFlow                  : BOOLEAN;
      s_binString                 : bit_String;

BEGIN

      GETBYTENO(i_1Byte,i_2Byte,i_Byte,i_Bit);
      IF i_Bit = i_NoOfBit THEN
          BEGIN
            r_realposval :=  1.0 * r_8posbinary;
            r_realnegval := -1.0 * r_8posbinary;
          END
      ELSE
          BEGIN
            r_realposval :=  1.0 * r_16posbinary;
            r_realnegval := -1.0 * r_16posbinary;
          END;

      r_LowRange  := r_realnegval;
      r_HighRange := r_realposval;

      GETREALNUM(r_LowRange,r_HighRange,r_RealNum,b_Overflow);
      WRITE (r_RealNum:5:5,' will be stored in ',i_byte, ' byte(s) as : ');
      WRITE('"');
      TEXTCOLOR(YELLOW);
      CALREALBIN(r_RealNum,i_Bit,b_OverFlow,s_binstring);  { Real Integer to binary routine }
      BIT_STRING_PRINT(s_binstring,i_bit);   { Print binary string }
      TEXTCOLOR(WHITE);
      WRITE('".');
      WRITELN;

END; {REALTOBIN}


{/////////////////////////////////////////////////////////////////////////////
 Binary to real number calculation
/////////////////////////////////////////////////////////////////////////////}
FUNCTION BINTOREALNUM(s_binary:STRING;  i_Bit:INTEGER):REAL;

VAR

      i,j, r_num : REAL;
      k,l        : INTEGER;
      m          : LONGINT;

BEGIN

       r_num := 0;

       IF i_Bit = i_NoOfBit THEN  { No. of bits per bytes }

          BEGIN

             k := i_8BitExpInd;     {4 for 8 bit, 16 for 16 bit}
             l := GETEXPVAL(s_binary,i_8ExpStartBit,i_8ExpEndBit,k);
             m := RAISEPOWER(i_base2,ABS(l));

             IF l < 0 THEN
                i := 1.0 / m
             ELSE
                i := m;

             j := GETMANVAL(s_binary,i_8ManStartBit,i_8ManEndBit);

          END

       ELSE

          BEGIN
             k := i_16BitExpInd;    {16}
             l := GETEXPVAL(s_binary,i_16ExpStartBit,i_16ExpEndBit, k);
             m := RAISEPOWER(i_base2,ABS(l));

             IF l < 0 THEN  { If l is negative }
                i := 1.0 / m
             ELSE
                i := m;

             j := GETMANVAL(s_binary,i_16ManStartBit,i_16ManEndBit);
          END;

       r_num := i * j;   { Exponent * mantissa }

       IF s_binary[1] = s_OneString THEN { Negative }
          r_num := r_num * i_NegativeOne;

       BINTOREALNUM := r_num;

END; {BINTOREALNUM}


{/////////////////////////////////////////////////////////////////////////////
 Binary string to real number
/////////////////////////////////////////////////////////////////////////////}
PROCEDURE BINTOREAL;

VAR

     b_okay      : boolean;
     s_binary    : string;
     i_X,i_Y, i  : INTEGER;
     r_realnum   : REAL;

BEGIN

     GETBYTENO(i_1Byte,i_2Byte,i_Byte,i_Bit);

     REPEAT

         BEGIN

           b_okay := TRUE;
           s_binary := '';
           GOTOXY(1,12);
           WRITE ('Please enter a binary string in ',i_Bit, ' bit format : ');
           i_X := WHEREX;
           i_Y := WHEREY;
           CLREOL;
           TEXTCOLOR(YELLOW);
           READLN (s_binary);
           TEXTCOLOR(WHITE);
           FOR i := LENGTH(TRIM(s_binary)) DOWNTO 1 DO
                  IF NOT (s_binary[i] = s_ZeroString) AND NOT (s_binary[i] = s_OneString) THEN
                      BEGIN
                            b_okay := FALSE;
                            GOTOXY(i_X,i_Y);
                            CLREOL;
                      END

         END

     UNTIL (b_okay = TRUE) AND (LENGTH(TRIM(s_binary)) = (i_Bit));

     r_realnum := BINTOREALNUM(s_binary,i_Bit);

     WRITE ('"', s_binary, '" binary string represents real number : ');
     TEXTCOLOR(YELLOW);
     WRITE(r_realnum:6:13);
     TEXTCOLOR(WHITE);
     WRITELN('.');

END; {BINTOREALNUM}


{/////////////////////////////////////////////////////////////////////////////
 Make appropriate choice from the options
/////////////////////////////////////////////////////////////////////////////}
PROCEDURE MAKECHOICE;

BEGIN

      CASE i_choice OF

          1: INTTOBIN;
          2: BINTOINT;
          3: REALTOBIN;
          4: BINTOREAL;

      END;

END; {MAKECHOICE}


{////////////////////////////////////////////////////////////////////////////
 Get what option the user wants
////////////////////////////////////////////////////////////////////////////}
PROCEDURE GETCHOICE(i_LoLimit,i_HiLimit:INTEGER;
                    VAR     i_getChoice:INTEGER);

VAR

       i_X,i_Y      : INTEGER;  { Local variable for x,y coordinate value }

BEGIN

       REPEAT

           GOTOXY(1,10);
           WRITE('Enter your choice (',i_LowLimit:1,' - ',i_HighLimit:1,') : ');
           i_X := WHEREX;
           i_Y := WHEREY;
           {$I-}
           TEXTCOLOR(YELLOW);
           READLN(i_getChoice);
           TEXTCOLOR(WHITE);
           {$I+}
           IF (IORESULT <> i_OKIOResult) OR (i_choice < i_LoLimit) OR
              (i_choice > i_HiLimit) THEN
              GOTOXY(i_X,i_Y);
              CLREOL;

       UNTIL (IORESULT = i_OKIOResult) AND
             (i_choice >= i_LoLimit) AND
             (i_choice <= i_HiLimit)

END; {GETCHOICE}


{/////////////////////////////////////////////////////////////////////////////
 Displays the main menu for user to choose
/////////////////////////////////////////////////////////////////////////////}
PROCEDURE DISPMENU;

BEGIN

    CLRSCR;
    WRITELN ('              +--------------------------------------------------+');
    WRITELN ('              |  << BASE 10/BASE 2 NUMBER CONVERSION PROGRAM >>  |');
    WRITELN ('              |      1. Integer Number ---> Binary  String       |');
    WRITELN ('              |      2. Binary  String ---> Integer Number       |');
    WRITELN ('              +--------------------------------------------------+');
    WRITELN ('              |      3. Real    Number ---> Binary  String       |');
    WRITELN ('              |      4. Binary  String ---> Real    Number       |');
    WRITELN ('              |      5. Quit                                     |');
    WRITELN ('              +--------------------------------------------------+');

END; {DISPMENU}


{/////////////////////////////////////////////////////////////////////////////
 Main Pogram
/////////////////////////////////////////////////////////////////////////////}
BEGIN

     TEXTCOLOR(WHITE);
     TEXTBACKGROUND(BLUE);

     REPEAT

         CLRSCR;
         DISPMENU;                                    { Display heading }
         GETCHOICE(i_LowLimit,i_HighLimit,i_Choice);  { Get choice option }
         IF i_Choice < i_highLimit THEN
            BEGIN
                MAKECHOICE;                           { Make a choice }
                PRESSKEY;
                s_response := READKEY;
            END;

     UNTIL (i_choice = i_highlimit)

END. {MAIN PROGRAM}

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