*******************************************************************************
*  CV_READ - User Defined Functions that provide the ability to read BASIC    *
*            numbers stored by the MKI$/MKS$/MKD$ functions.                  *
*                                                                             *
*  Created - 07/18/89 by John Wright, WRIGHTware                              *
*                                     72 Eastern Avenue                       *
*                                     Arlington, MA  02174                    *
*            (c) 1989 - All rights reserved.                                  *
*                                                                             *
*  Revised - 07/19/90 - Fixed a problem with precision on numbers in the      *
*                       range 0.5040 to 0.5624.                               *
*                                                                             *
*=============================================================================*
*                                                                             *
*  Function     Description                                                   *
*  --------     ------------------------------------------------------------- *
*  CVI          Convert data stored by BASIC as an integer                    *
*  CVS          Convert data stored by BASIC as a single precision number     *
*  CVD          Convert data stored by BASIC as a double precision number     *
*  NEG_BIN      Convert the binary decimal items using negative power of 2    *
*  SHOW_BIN     Show the actual binary number to examine layout               *
*  STRIPBIN     Remove the letter B from binary numbers and pad with zeros    *
*                                                                             *
*=============================================================================*
*                                                                             *
*  ProClip 3.0 functions by GENESIS DEVELOPMENT CORPORATION.                  *
*  ---------------------------------------------------------                  *
*  BIN2DEC      Convert binary to decimal  (requires PROCLIP.LIB)             *
*  DEC2BIN      Convert decimal to binary  (requires PROCLIP.LIB)             *
*                                                                             *
*******************************************************************************


*!*********************************************************************
*!
*!       Function: CVI()
*!
*!*********************************************************************
FUNCTION cvi
* Translate a two-byte string to actual numbers  ( BASIC's CVI function )
* Syntax: CVI(<chr>)
PARAMETER bas_str
RETURN ASC(SUBSTR(bas_str,1,1))+(ASC(SUBSTR(bas_str,2,1))*256)


*!*********************************************************************
*!
*!       Function: CVS()
*!
*!          Calls: STRIPBIN()     (function  in CV_READ.PRG)
*!               : NEG_BIN()      (function  in CV_READ.PRG)
*!
*!*********************************************************************
FUNCTION cvs
* Translate a four-byte string to actual numbers  ( BASIC's CVS function )
* Syntax: CVS(<chr>)
PARAMETER bas_str

IF bas_str = REPLICATE(CHR(0),4)    && zero is stored as NULL characters
  RETURN 0
ENDIF

* Single precision numbers are stored as four bytes by MKS function in BASIC.
* The four bytes that comprise the single-precision number
bas1=stripbin(Dec2bin(ASC(SUBSTR(bas_str,1,1))))
bas2=stripbin(Dec2bin(ASC(SUBSTR(bas_str,2,1))))
bas3=stripbin(Dec2bin(ASC(SUBSTR(bas_str,3,1))))
bas4=stripbin(Dec2bin(ASC(SUBSTR(bas_str,4,1))))

* the string is read from RIGHT to LEFT !!!
n_bin_str=bas4+bas3+bas2+bas1

* The exponent byte contains the binary number used to calculate exponent.
* This number is subtracted by 128 to get the actual exponent value.
* The exponent refers to a power of two, by which the mantissa is multiplied.
cv_exp=ASC(SUBSTR(bas_str,4,1)) - 128

* The first character of the third byte contains the sign bit.
* If the number is positive it equals 0; if negative it equals 1.
cv_pos=IF(SUBSTR(n_bin_str,9,1)="0",.T.,.F.)

* The final 23 characters contain the mantissa.  All binary numbers except
* zero start with a 1.  This is not contained in the mantissa bytes.
cv_man="1"+SUBSTR(n_bin_str,10,23)

IF cv_exp > 0
  * Translate the binary number to integer.
  cv_val=Bin2dec(SUBSTR(cv_man,1,cv_exp+1))

  * Translate the binary number to decimal equivalent.
  cv_dec=neg_bin(SUBSTR(cv_man,cv_exp+1))

  cv_val=cv_val+cv_dec

ELSE
  * only a decimal value; move decimal to left by adding zeros
  cv_val=neg_bin(REPLICATE("0",-1*cv_exp)+cv_man)
ENDIF

IF .NOT. cv_pos
  cv_val=cv_val * -1
ENDIF

RETURN cv_val


*!*********************************************************************
*!
*!       Function: CVD()
*!
*!          Calls: STRIPBIN()     (function  in CV_READ.PRG)
*!               : NEG_BIN()      (function  in CV_READ.PRG)
*!
*!*********************************************************************
FUNCTION cvd
* Translate an eight-byte string to actual numbers  ( BASIC's CVD function )
* Syntax: CVD(<chr>)
PARAMETER bas_str

IF bas_str = REPLICATE(CHR(0),8)    && zero is stored as NULL characters
  RETURN 0
ENDIF

* Double precision numbers are stored as eight bytes by MKD function in BASIC.
* The eight bytes that comprise the single-precision number
bas1=stripbin(Dec2bin(ASC(SUBSTR(bas_str,1,1))))
bas2=stripbin(Dec2bin(ASC(SUBSTR(bas_str,2,1))))
bas3=stripbin(Dec2bin(ASC(SUBSTR(bas_str,3,1))))
bas4=stripbin(Dec2bin(ASC(SUBSTR(bas_str,4,1))))
bas5=stripbin(Dec2bin(ASC(SUBSTR(bas_str,5,1))))
bas6=stripbin(Dec2bin(ASC(SUBSTR(bas_str,6,1))))
bas7=stripbin(Dec2bin(ASC(SUBSTR(bas_str,7,1))))
bas8=stripbin(Dec2bin(ASC(SUBSTR(bas_str,8,1))))

* the string is read from RIGHT to LEFT !!!
n_bin_str=bas8+bas7+bas6+bas5+bas4+bas3+bas2+bas1

* The exponent byte contains the binary number used to calculate exponent.
* This number is subtracted by 128 to get the actual exponent value.
* The exponent refers to a power of two, by which the mantissa is multiplied.
cv_exp=ASC(SUBSTR(bas_str,8,1)) - 128

* The first character of the seventh byte contains the sign bit.
* If the number is positive it equals 0; if negative it equals 1.
cv_pos=IF(SUBSTR(n_bin_str,9,1)="0",.T.,.F.)

* The final 55 characters contain the mantissa.  All binary numbers except
* zero start with a 1.  This is not contained in the mantissa bytes.
cv_man="1"+SUBSTR(n_bin_str,10,55)

IF cv_exp >= 0
  * Translate the binary number to integer.
  cv_val=Bin2dec(SUBSTR(cv_man,1,cv_exp+1))

  * Translate the binary number to decimal equivalent.
  cv_dec=neg_bin(SUBSTR(cv_man,cv_exp+1))

  cv_val=cv_val+cv_dec
ELSE
  * only a decimal value; move decimal to left by adding zeros
  cv_val=neg_bin(REPLICATE("0",-1*cv_exp)+cv_man)
ENDIF

IF .NOT. cv_pos
  cv_val=cv_val * -1
ENDIF

RETURN cv_val


*!*********************************************************************
*!
*!       Function: NEG_BIN()
*!
*!      Called by: CVS()          (function  in CV_READ.PRG)
*!               : CVD()          (function  in CV_READ.PRG)
*!
*!*********************************************************************
FUNCTION neg_bin
* Convert the binary decimal items using negative power of 2
PARAMETER x_str
PRIVATE X
STORE 0 TO x_amt
FOR X = 1 TO LEN(x_str)
  x_amt=x_amt+IF(SUBSTR(x_str,X,1)="1",2^-X,0)
NEXT
RETURN x_amt


*!*********************************************************************
*!
*!       Function: SHOW_BIN()
*!
*!          Calls: STRIPBIN()     (function  in CV_READ.PRG)
*!
*!*********************************************************************
FUNCTION show_bin
* Show the binary number string
PARAMETER bas_str
STORE "" TO bas_it
* the string is read from RIGHT to LEFT !!!
FOR X = LEN(bas_str) TO 1 STEP -1
  bas_it=bas_it+stripbin(Dec2bin(ASC(SUBSTR(bas_str,X,1))))
NEXT
RETURN bas_it


*!*********************************************************************
*!
*!       Function: STRIPBIN()
*!
*!      Called by: CVS()          (function  in CV_READ.PRG)
*!               : CVD()          (function  in CV_READ.PRG)
*!               : SHOW_BIN()     (function  in CV_READ.PRG)
*!
*!*********************************************************************
FUNCTION stripbin
* Strip off the "B" from binary numbers and replace with zeros to 8 places.
* The ProClip DEC2BIN function puts a "B" at the end of the binary number.
* Values from 1-15 only have four digits; need to add zeros to front.
PARAMETER x_bin
RETURN SUBSTR(IF(LEN(x_bin)<8,"0000","")+x_bin,1,8)

*: EOF: CV_READ.PRG