'===========================================================================
' Subject: PASCAL REAL TO QBASIC DOUBLE      Date: 02-24-97 (00:00)       
' Author:  Steven Edwards                    Code: QB, QBasic, PDS        
' Origin:  Charles Quante                  Packet: MISC.ABC
'===========================================================================
'This little routine I came up with proved to be very useful to me. I hope you think it 'would be very useful to others as well.
'
'  From:  Steven Edwards
'  Date:  02/24/97
'  Re:    Converting Pascal Random Access files REAL data types
'         to QBASIC usable DOUBLE data type
'
'
'This was the original pascal data structure from the source code:
'
'    EmployeeType = record
'                 EmpName      : string[30];
'                 Number    : integer;
'                 Wage      : real;
'               end; {record}
'
'This Record structure was used to build a random access file.
'The Pascal string is easy to convert:
'  EmployeeType.EmpName is actually 31 bytes.
'  The first byte is the number of chars in the 30 that the EmpName
'  actually occupies;  the remaining 30 are alpha-numeric chars
'  that make up the actual EmpName plus any garbage left over from
'  previous strings.  Use the number from the first byte to strip
'  out the valid sting from the remaining 30 bytes.
'
'The Pascal real was not so easy to convert:
'  The pascal real is contained in the following layout:
'
'  765432107654321076543210765432107654321076543210  <- bit structure
'  |------|--------------------------------^------|
'  |      |                                ^      |
'  exponent          Significand           ^
'  as byte           as 5 bytes            this is the pos/neg bit
'
'  After searching long and hard for a conversion routine and not
'  finding one, I set about creating my own.  Using the Borland
'  Pascal Language Guide and some old Turbo Pascal source code as
'  a guide, I managed to convert over the information with the
'  following routines.  They basically do the following:
'
'  765432107654321076543210765432107654321076543210
'  |------|-------|-------|-------|-------|-------|
'   byte1   byte2   byte3   byte4   byte5   byte6  <- held as string * 6
'
'  1. Check bit 7 of byte 6 for pos/neg flag
'  2. Check each bit (0-7) of each byte (2-6) of the significand and
'     multiply it out by its respective power
'     (Ex.: byte 2 bit 0 is power of 1 ; byte 6 bit 7 is power of 40)
'  3. Normalize the final number (divide by 2 to the power of 40)
'  4. Calculate in the exponent (from the pascal book : * 2 to the power
'     of the exponent-128)
'  5. Adjust the sign
'
'  Here is a sample of the source I am using.  It only calculates out for
'  reading of the real number.  Maybe someone with more
DECLARE FUNCTION power# (x!, y AS INTEGER)
DECLARE SUB RealConv (RealCost AS ANY, NewCost#)
'  the QBASIC equivalent of the above Pascal struct:
TYPE PASdataRecord
        EmpNameLength AS STRING * 1
        EmpName AS STRING * 30
        Number AS INTEGER
        Wage AS STRING * 6
END TYPE
'  set up the file to be opened and read from QBASIC
DIM EmployeeDAT AS PASdataRecord
OPEN "EMPLOY.DAT" FOR RANDOM ACCESS READ LOCK WRITE AS #1 LEN = LEN(EmployeeDAT)
'  read the file a record at a time until the end
DO WHILE NOT EOF(1)
   CLS
   Count = Count + 1
   SEEK #1, Count
   GET #1, , EmployeeDAT
'  strip out the actual string using the first length byte
   EmployeeDAT.EmpName = MID$(EmployeeDAT.EmpName, 1, ASC(EmployeeDAT.EmpNameLength))
'  the following routine converts the pascal real to Qbasic double
   CALL RealConv(EmployeeDAT.Wage, BASwage#)
   PRINT "Employee number = "; EmployeeDAT.Number
   PRINT "Employee EmpName   = "; EmployeeDAT.EmpName
   PRINT "Employee wage   = "; BASwage
LOOP


FUNCTION power# (x, y AS INTEGER)
'  simple x to the power of y function
   power# = EXP(y * LOG(x))
END FUNCTION

SUB RealConv (Real$, NewCost#)
'  create an array to hold each byte of the real string
   DIM RealHold(6)
   RealHold(1) = ASC(MID$(Real$, 1, 1))
   RealHold(2) = ASC(MID$(Real$, 2, 1))
   RealHold(3) = ASC(MID$(Real$, 3, 1))
   RealHold(4) = ASC(MID$(Real$, 4, 1))
   RealHold(5) = ASC(MID$(Real$, 5, 1))
   RealHold(6) = ASC(MID$(Real$, 6, 1))
'  if positive contains a number then its negative
   positive = &H80 AND RealHold(6)
'  clear the Pos/Neg bit from byte 6
   RealHold(6) = &H80 OR RealHold(6)
'  set up the significand as 1.0
   Significand# = 1#
'  check each individual bit for on/off;  if on then multiply out the
'  number (2,4,8,16,32,64,128, etc.)
   FOR bytecheck = 2 TO 6
'  bit 0 of byte
      IF (RealHold(bytecheck) AND &H1) = 1 THEN
         Significand# = Significand# + power(2, (0 + (bytecheck - 2) * 8))
      END IF
'  bit 1 of byte
      IF (RealHold(bytecheck) AND &H2) = 2 THEN
         Significand# = Significand# + power(2, (1 + (bytecheck - 2) * 8))
      END IF
'  bit 2 of byte
      IF (RealHold(bytecheck) AND &H4) = 4 THEN
         Significand# = Significand# + power(2, (2 + (bytecheck - 2) * 8))
      END IF
'  bit 3 of byte
      IF (RealHold(bytecheck) AND &H8) = 8 THEN
         Significand# = Significand# + power(2, (3 + (bytecheck - 2) * 8))
      END IF
'  bit 4 of byte
      IF (RealHold(bytecheck) AND &H10) = 16 THEN
         Significand# = Significand# + power(2, (4 + (bytecheck - 2) * 8))
      END IF
'  bit 5 of byte
      IF (RealHold(bytecheck) AND &H20) = 32 THEN
         Significand# = Significand# + power(2, (5 + (bytecheck - 2) * 8))
      END IF
'  bit 6 of byte
      IF (RealHold(bytecheck) AND &H40) = 64 THEN
         Significand# = Significand# + power(2, (6 + (bytecheck - 2) * 8))
      END IF
'  bit 7 of byte
      IF (RealHold(bytecheck) AND &H80) = 128 THEN
         Significand# = Significand# + power(2, (7 + (bytecheck - 2) * 8))
      END IF
NEXT
'  normalize the number by dividing calculated number by a number with all
'  bits turned on: 2 to the power of 40
Significand# = Significand# / power(2, 40)
'  calculate in the exponent
Number# = Significand# * power(2, (RealHold(1) - 128))
'  set the pos/neg sign
IF positive > 0 THEN Number# = Number# * -1
NewCost# = Number#
END SUB