REM M2CBLIB.BAS V1.3
REM CBASIC INTERPRETER USERS - THESE FUNCTIONS MAY BE PULLED
REM   DIRECTLY INTO YOUR PROGRAM BY USING THE 'INTFNS' OPTION OF
REM   M2CBASIC.  PLEASE FOLLOW THESE RULES SHOULD YOU NEED 
REM   TO MODIFY THIS LIBRARY:
REM     1)  LEAVE THE EXISTING 'DEF' AND 'FEND' STMTS IN COLUMN 1.
REM     2)  LEAVE THE EXISTING DEFINITIONS IN THEIR ORIGINAL ORDER.

REM *** INTRINSIC HANDLERS ***

DEF CDBL(X) PUBLIC
    REAL X

    CDBL = X
    RETURN
FEND

DEF CINT(X) PUBLIC
    INTEGER  CINT
    REAL     X

    CINT = SGN(X) * INT%(ABS(X) + .5)
    RETURN
FEND

DEF CSNG(X) PUBLIC
    INTEGER I%,K%               
    REAL X
   
    K% = VARPTR(X)
    FOR I%= 1 TO 4
        POKE K%+I%,00H
    NEXT I%
    CSNG=X
    RETURN
FEND

DEF FIX(X) PUBLIC
    INTEGER  FIX
    REAL     X
  
    FIX = SGN(X) * INT%(ABS(X))
    RETURN
FEND

DEF HEX$(I%) PUBLIC
    INTEGER I%, J%, K%, M%
    STRING  HEX$, X$, NX$, AC$


    IF I% = -32768 THEN HEX$ = "8000" : RETURN
    IF I% < O THEN\
        J% = ABS(I%) : J% = J% - 1 \
    ELSE\                                                 ELSE\ 
        J% = I% 

                                
    X$ = "" 
    FOR K% = 1 TO  4
         M% = INT%(J% / 16) 
         L% = J% - M% * 16
         IF L% <= 9 THEN\
             X$ =  CHR$(48 + L%) + X$\
         ELSE\
             X$ =  CHR$(55 + L%) + X$
         J% = M% 
    NEXT K%

    K% = 0
    C$ = MID$(X$, K%+1, 1)
    WHILE C$ = "0" AND K% < 3 AND I% >= 0
        K% = K% + 1
        C$ = MID$(X$, K% + 1, 1)
    WEND
    HEX$ = RIGHT$(X$, 4 - K%)    
    IF I% >= 0 THEN  RETURN
        
    NX$ =  ""
    FOR K% = 1 TO 4       
         C$ = MID$(X$,K%, 1)
         IF C$ >= "A" THEN\
             AC% = ASC("F") - ASC(C$) + ASC("0")\
         ELSE IF C$ >= "6" THEN\
             AC% = ASC("F") - ASC(C$) + ASC("0") - 7\
         ELSE\
             AC% = ASC("F") - ASC(C$) + ASC("0")
         C$ = CHR$(AC%)
         NX$ =  NX$ + C$        
    NEXT K%
    HEX$ = NX$
    RETURN
FEND

DEF INKEY$ PUBLIC
    STRING INKEY$

    IF CONSTAT% < 0 THEN\
        INKEY$ = CHR$(INKEY)\
    ELSE\
        INKEY$ = ""
    RETURN
FEND

DEF INPUT$ (CNT, FNUM) PUBLIC
    REM FNUM = -1 FOR CONSOLE INPUT
    STRING  INPUT$, S$
    INTEGER CNT, FNUM, I

    S$ = ""
    IF CNT > 0 THEN \
        IF FNUM > 0 THEN \
            GOSUB DISK.INPUT \
        ELSE \
            GOSUB CONSOLE.INPUT

    INPUT$ = S$
    RETURN

    DISK.INPUT: \
        FOR I = 1 TO CNT :\
            S$ = S$ + CHR$(GET(FNUM)) \
        NEXT I
        RETURN

    CONSOLE.INPUT: \
        FOR I = 1 TO CNT
            S$ = S$ + CHR$(INKEY)
        NEXT I
        RETURN

FEND

DEF INSTR(I%, X$, Y$) PUBLIC
    INTEGER  I%, INSTR
    STRING   X$, Y$ 

    INSTR = MATCH(Y$, X$, I%)
    RETURN
FEND

DEF INSTR2(X$, Y$) PUBLIC
    INTEGER  I%, INSTR2
    STRING   X$, Y$

    INSTR2 = MATCH(Y$, X$, 1)
    RETURN
FEND

DEF MID2$(X$, I%) PUBLIC
    INTEGER  I%
    STRING   X$
            
    MID2$ = MID$(X$, I%, LEN(X$))
    RETURN
FEND

DEF OCT$(I%) PUBLIC
     INTEGER  I%, J%, K%, L%
     STRING   VOCT$, OCT$, NOCT$, C$
  
    VOCT$ = ""
    IF I% = -32768 THEN OCT$ = "100000" : RETURN
    IF I% < 0 THEN\
        J% = ABS(I%) :\
        J% = J% - 1\
    ELSE\
        J% = I%
  
    FOR N% = 1 TO 6
        L% = J%
        J% = J% / 8
        K% = L% - 8 * J%
        VOCT$ =  CHR$(48 + K%) + VOCT$
    NEXT N%

    N% = 0
    C$ = MID$(VOCT$,N%+1,1)  
    WHILE C$ = "0" AND N% < 5 AND I% >= 0
         N% = N% + 1
         C$ = MID$(VOCT$,N%+1,1)
    WEND
    OCT$ = RIGHT$(VOCT$,6-N%)
  
    IF I% >= 0 THEN  RETURN    

    NOCT$ = "1" 
    FOR N% = 2 TO 6
         C$ = MID$(VOCT$, N%, 1)
         NOCT$ =  NOCT$ + CHR$(ASC("7") - ASC(C$) + ASC("0"))
    NEXT N%:\
    OCT$ = NOCT$        
    RETURN
FEND

DEF RNDM (X) PUBLIC
    REAL X, RNDM

    RNDM = RND
    RETURN
FEND

DEF SPACE$(I%) PUBLIC
    INTEGER I%, J%
    STRING  SPACE$, SP$

    SP$ = ""
    FOR J% = 1 TO I%
        SP$ = SP$ + " "
    NEXT J%
    SPACE$ = SP$
    RETURN
FEND

DEF SPC(I%) PUBLIC
    INTEGER I%, J%
    STRING  SPC, SPAC$

    SPAC$ = ""
    FOR J% = 1 TO I%
        SPAC$ = SPAC$ + " "
    NEXT J%
    SPC = SPAC$
    RETURN
FEND

DEF STRC$ (CNT, A$) PUBLIC
    REM IMPLIMENTS STRING$ W/ 2ND ARG CHAR.
    STRING  STRC$, A$, S$
    INTEGER CNT, I

    IF LEN(A$) = 0 THEN \
        A$ = " "
    A$ = LEFT$(A$, 1)
    S$ = ""
    IF CNT > 0 THEN \
        FOR I = 1 TO CNT :\
            S$ = S$ + A$ :\
        NEXT I

    STRC$ = S$
    RETURN
FEND

DEF STRN$ (CNT, N) PUBLIC
    REM IMPLIMENTS STRING$ W/ 2ND ARG NUMERIC
    STRING  STRN$, S$
    INTEGER CNT, N, I

    S$ = ""
    IF CNT > 0 THEN \
        FOR I = 1 TO CNT :\
            S$ = S$ + CHR$(N) :\
        NEXT I

    STRN$ = S$
    RETURN
FEND

REM *** CHARACTER <-> NUMERIC  CONVERSION HANDLERS (USED IN RANDOM I/O) ***

DEF CVI%(A$) PUBLIC
    STRING   A$
    INTEGER  CVI%

    CVI% = PEEK(SADD(A$) + 2) + PEEK(SADD(A$) + 3) * 256  
    RETURN
FEND

DEF MKI$(I%) PUBLIC
     STRING   MKI$
     INTEGER  I%


    MKI$ = CHR$(PEEK(VARPTR(I%))) + \
                 CHR$(PEEK(VARPTR(I%) + 1))        
    RETURN

FEND

REM *** THE FOLLOWING FUNCTIONS (CVD, CVS, MKD$, MKS$)
REM *** ARE NEW IN V1.3 OF M2CBASIC.  THEY ASSUME NUMBERS
REM *** ARE IN CB80 FORMAT AND MAY BE USED IN PROGRAMS WHICH CREATE NEW
REM *** FILES AS WELL AS PROGRAMS WHICH ACCESS FILES CONVERTED BY THE RANDOM
REM *** FILE CONVERSION UTILITY M2CBCONV (ASSUMING YOU GIVE PARAMETERS
REM *** WHICH INDICATE THE LOCATION OF ALL REAL QUANTITIES)
REM *** PROGRAMS CONVERTED PRIOR TO V1.3 NEED NOT BE RECONVERTED
REM *** SIMPLY RECOMPILE M2CBLIB AND RE-LINK. SEE DOC FOR MORE INFO

DEF CVD(DPNUM$) PUBLIC
    REM  STRING CONTAINING CB80 DOUBLE -> REAL
    REAL   CVD, X
    STRING DPNUM$, A$
    INTEGER I%, K%

    K% = VARPTR(X)

    FOR I% = 0 TO 7
      A$ = MID$(DPNUM$,I%+1,1)
      POKE K%+I%,ASC(A$)
    NEXT I%

    CVD = X
    RETURN
FEND

DEF CVS(SPNUM$) PUBLIC
    REM  STRING CONTAINING CB80 SINGLE -> REAL
    REAL   CVS, X
    STRING SPNUM$, A$
    INTEGER I%, K%

    K% = VARPTR(X)
    A$ = MID$(SPNUM$,1,1)    
    POKE K%,ASC(A$)

    FOR I% = 1 TO 4
      POKE K%+I%,0
    NEXT I%

    FOR I% = 5 TO 7
      A$ = MID$(SPNUM$,I%-3,1)
      POKE K%+I%,ASC(A$)
    NEXT I%

    CVS = X
    RETURN
FEND

DEF MKD$(X) PUBLIC
    REM  REAL -> STRING CONTAINING CB80 DOUBLE
    REAL    X
    STRING  MKD$, DPNUM$
    INTEGER I%, K%

    K% = VARPTR(X)
    DPNUM$ = CHR$(PEEK(K%))

    FOR I% = 1 TO 7
      DPNUM$ = DPNUM$ + CHR$(PEEK(K%+I%))
    NEXT I%

    MKD$ = DPNUM$
    RETURN
FEND

DEF MKS$(X) PUBLIC
    REM  REAL -> STRING CONTAINING CB80 SINGLE
    REAL   X
    STRING MKS$, SPNUM$
    INTEGER I%, K%

    K% = VARPTR(X)
    SPNUM$ = CHR$(PEEK(K%))

    FOR I% = 5 TO 7
      SPNUM$ = SPNUM$ + CHR$(PEEK(K%+I%))
    NEXT I%

    MKS$ = SPNUM$
    RETURN
FEND

REM *** THE FOLLOWING FUNCTIONS (MCVD, MCVS, MMKD$, MMKS$)
REM *** ARE THE RELEASE V1.1 AND V1.2 FUNCTIONS CVS, CVD, MKS$, MKD$
REM *** THEY OPERATE ON MICROSOFT FORMAT AND ARE QUITE SLOW COMPARED
REM *** TO THEIR NEW EQUIVALENTS (ABOVE) WHICH ASSUME CB80 FORMAT 
REM *** INTEGERS ARE STORED THE SAME AND ARE THEREFORE NOT A PROBLEM

DEF MCVD(A$) PUBLIC
    REM     STRING CONTAINING MICROSOFT DOUBLE -> REAL
    REAL    MCVD, X, E, T, V, Y
    STRING  A$
    INTEGER I%, EX%

    EX% =ASC(RIGHT$(A$,1))
    E = EXP(LOG(2) * (EX% - 128))
    V = ASC(MID$(A$,7,1))
    IF V >= 128 THEN\
        Y = -1 \
    ELSE\
        Y = 1: V = V + 128
    X = V /256
    T = 256
    FOR I% = 1 TO 6
        T = 256 * T
        V = ASC(MID$(A$,7-I%,1))
        X =  X + V/T
    NEXT I%
    MCVD = Y * X * E
    RETURN
FEND  
    
DEF MCVS(A$) PUBLIC
    REM     STRING HOLDING MICROSOFT SINGLE -> REAL
    REAL    MCVS, X, E, T, V, C, Y
    STRING  A$
    INTEGER I%, EX%, K%

    EX% =ASC(RIGHT$(A$,1))
    E = EXP(LOG(2) * (EX% - 128))
    V = ASC(MID$(A$,3,1))
    IF V >= 128 THEN\
        Y = -1 \
    ELSE\
        Y = 1: V = V + 128
    X = V /256
    T = 256
    FOR I% = 1 TO 2
        T = 256 * T
        V = ASC(MID$(A$,3-I%,1))
        X =  X + V/T
    NEXT I%
    C = Y * X * E
    K% = VARPTR(C)
    FOR I%= 1 TO 4
        POKE K%+I%,00H
    NEXT I%
    MCVS = C
    RETURN
FEND  
    
DEF MMKD$(X) PUBLIC
    REM REAL -> STRING CONTAINING MICROSOFT DOUBLE
    STRING  MMKD$, M$
    REAL    LG, X, M, U
    INTEGER EX%, V%, I%

    IF X = 0 THEN MMKD$ = CHR$(0) + CHR$(0) + CHR$(0)\
                       + CHR$(0) + CHR$(0) + CHR$(0)\
                       + CHR$(0) + CHR$(0) : RETURN
    LG = LOG(ABS(X)) / LOG(2)
  REM IF LG TOO LARGE
    EX% = INT%(LG) + 1
    M  = LG - EX%
    U = EXP(M * LOG(2))
    WHILE U < .5
        U = U * 2
        EX% = EX% - 1
    WEND
    U = U * 256
    V% = INT%(U)
    U = U - V%
    IF X > 0 THEN V% = V% - 128
    M$ = CHR$(V%) + CHR$(EX% + 128)
    FOR I% = 1 TO 6
        U = U * 256
        V% = INT%(U)
        U = U - V%
        M$ = CHR$(V%) + M$
   NEXT I%
   MMKD$ = M$
   RETURN
FEND

DEF MMKS$(X) PUBLIC
    REM REAL -> STRING CONTAINING MICROSOFT SINGLE
    STRING  MMKS$, M$
    REAL    LG, X, M, U
    INTEGER EX%, V%, I%

    IF X = 0 THEN MMKS$ = CHR$(0) + CHR$(0) + CHR$(0)\
                       + CHR$(0) : RETURN
    LG = LOG(ABS(X)) / LOG(2)
  REM IF LG TOO LARGE
    EX% = INT%(LG) + 1
    M  = LG - EX%
    U = EXP(M * LOG(2))
    WHILE U < .5
        U = U * 2
        EX% = EX% - 1
    WEND
    U = U * 256
    V% = INT%(U)
    U = U - V%
    IF X > 0 THEN V% = V% - 128
    M$ = CHR$(V%) + CHR$(EX% + 128)
    FOR I% = 1 TO 2
        U = U * 256
        V% = INT%(U)
        U = U - V%
        M$ = CHR$(V%) + M$
   NEXT I%
   MMKS$ = M$
   RETURN
FEND

REM *** OPERATOR HANDLERS ***

DEF EQV% (I%, J%) PUBLIC
    INTEGER EQV%, I%, J%

    EQV% = (I% AND J%) OR ( NOT (I% OR J%))
    RETURN
FEND

DEF IMP% (I%, J%) PUBLIC
    INTEGER IMP%, I%, J%

    IMP% = ( NOT I%) OR J%
    RETURN
FEND

DEF DIV% (I%, J%) PUBLIC
    INTEGER DIV%, I%, J%

    DIV% = INT%(I% / J%)
    RETURN
FEND

REM *** STATEMENT HANDLERS ***

DEF CFMT$ (OFMT) PUBLIC
    REM V1.3 CONVERT PRINT/LPRINT USING FORMAT STRINGS
    REM <BACKSLASH> -> "/"  AND  "_" -> <BACKSLASH>
    STRING CFMT$, NFMT, OFMT, CH
    INTEGER I

    NFMT = ""
    FOR I = 1 TO LEN(OFMT)
        CH = MID$(OFMT, I, 1)
        IF CH = "\"        \
          THEN CH = "/"    \
          ELSE IF CH = "_" \
            THEN CH = "\"
        NFMT = NFMT + CH
    NEXT I

    CFMT$ = NFMT
    RETURN
FEND

DEF MIDS$ (S1$, I%, J%, S2$) PUBLIC
    STRING  MIDS$, S1$, S2$, T$
    INTEGER I%, J%, LEN%

    IF I% > LEN(S1$) OR I% <= 0 \
      THEN MIDS$ = S1$ :\
           RETURN

    IF I% > 1 \
      THEN T$ = LEFT$(S1$, I%-1) \
      ELSE T$ = ""

    IF J% < 0 \
      THEN LEN% = LEN(S2$) \
      ELSE LEN% = J%
    IF LEN(S2$) < LEN% \
      THEN WHILE LEN(S2$) < LEN% :\
             S2$ = S2$ + " " :\
           WEND \
      ELSE S2$ = LEFT$(S2$, LEN%)
    T$ = T$ + S2$

    IF LEN(S1$) > LEN(T$) \
      THEN T$ = T$ + MID$(S1$, LEN(T$)+1, LEN(S1$)-LEN(T$)) \
      ELSE T$ = LEFT$(T$, LEN(S1$))

    MIDS$ = T$
    RETURN
FEND

REM *** RANDOM I/O SUPPORT ***

DEF SETFDV (F.V.ADDR%, BUF.ADDR%, OFFSET%) PUBLIC
    REM  SET FIELD VAR (CAUSED BY GET)
    INTEGER F.V.ADDR%, BUF.ADDR%, OFFSET%, I%

    F.V.LEN%  = PEEK(F.V.ADDR%+1) + 256*PEEK(F.V.ADDR%)
    F.V.ADDR% = F.V.ADDR% + 2           :REM GET PAST LENGTH
    BUF.ADDR% = BUF.ADDR% + OFFSET% + 1 :REM OFFSET - 1 + 2

    FOR I% = 1 TO F.V.LEN%
      POKE F.V.ADDR%,PEEK(BUF.ADDR%)
      F.V.ADDR% = F.V.ADDR% + 1
      BUF.ADDR% = BUF.ADDR% + 1
    NEXT I%
    RETURN
FEND

DEF SETRBF (BUF.ADDR%, OFFSET%, EXP$) PUBLIC
    REM  SET RANDOM FILE BUFFER (CAUSED BY LSET/RSET)
    INTEGER BUF.ADDR%, OFFSET%, I%
    STRING  EXP$

    BUF.ADDR% = BUF.ADDR% + OFFSET% + 1  :REM GET PAST LENGTH OFFSET - 1 + 2
    FOR I% = 1 TO LEN(EXP$)
      POKE BUF.ADDR%, ASC(MID$(EXP$,I%,1))
      BUF.ADDR% = BUF.ADDR% + 1
    NEXT I%
    RETURN
FEND

DEF LRSETV (F.V.ADDR%, EXP$) PUBLIC
    REM  SET FIELD VAR (CAUSED BY LSET/RSET)
    INTEGER F.V.ADDR%, I%
    STRING  EXP$

    F.V.ADDR% = F.V.ADDR% + 2 :REM GET PAST LENGTH
    FOR I% = 1 TO LEN(EXP$)
      POKE F.V.ADDR%, ASC(MID$(EXP$,I%,1))
      F.V.ADDR% = F.V.ADDR% + 1
    NEXT I%
    RETURN
FEND

DEF APNDCH (BUF$) PUBLIC
    REM  APPEND FLAGS - CAUSED BY PUT
    REM  A RECORD OF A RANDOM FILE IS TREATED AS ONE CHARACTER STRING
    REM  FOUR ASCII CODES MUST NOT BE PRESENT WITHIN A RECORD 
    REM  THESE ARE <LF> - 10  <CR> - 13  <SUB> - 26  " - 34
    REM  THIS ROUTINE TRANSLATES ANY OCCURENCES OF THESE CHARACTERS TO 
    REM  SOME OTHER ASCII CODE NOT FOUND IN THE RECORD AND STORES THAT
    REM  CODE AT THE FRONT OF THE RECORD.  ONE BYTE IS RESERVED FOR THIS
    REM  CHARACTER FOR EACH OF THE 4 CHARACTERS ABOVE.
    REM  IF NO OCCURENCES OF THE CHARACTER ARE FOUND A BLANK IS STORED
    STRING BUF$, APNDCH, TBUF$, T$, BAD.CODES$, REP.CODES$, REP.CH$
    INTEGER I%, J%, REP.CAND%, BC%

    BAD.CODES$ = CHR$(10) + CHR$(13) + CHR$(26) + CHR$(34)
    REP.CODES$ = ""   :REM THIS WILL BECOME THE FOUR FLAGS
    REP.CAND%  = 36   :REM START LOOKING FOR REPLACEMENT AT ASCII 36

    FOR BC% = 1 TO 4
      IF MATCH(MID$(BAD.CODES$,BC%,1),BUF$,1) = 0 \ 
        THEN \   NO PROBLEM - APPEND BLANK AND TRY THE NEXT ONE
          REP.CODES$ = REP.CODES$ + " " :\
          GOTO END.BC

      REM  LOOK FOR A CHARACTER TO REPLACE BAD CODE
      WHILE MATCH(CHR$(REP.CAND%),BUF$,1) > 0
        REP.CAND% = REP.CAND% + 1
      WEND

      TBUF$ = ""
      REP.CH$ = CHR$(REP.CAND%) :REM REPLACEMENT CHARACTER
      REP.CODES$ = REP.CODES$ + REP.CH$
      FOR J% = 1 TO LEN(BUF$)
        T$ = MID$(BUF$,J%,1)
        IF T$ = MID$(BAD.CODES$,BC%,1) \
          THEN TBUF$ = TBUF$ + REP.CH$ \ REPLACE BAD CODE
          ELSE TBUF$ = TBUF$ + T$
      NEXT J%
      BUF$ = TBUF$
 END.BC: NEXT BC%

    APNDCH = REP.CODES$ + BUF$
    RETURN
FEND

DEF REMVCH (BUF$) PUBLIC
    REM  REMOVE FLAGS - CAUSED BY GET (SEE APNDCH ABOVE)
    REM  IF FLAG CHARACTER IS BLANK NO ACTION IS REQUIRED
    REM  IF FLAG CHARACTER IS NON BLANK THEN CHANGE OCCURENCES
    REM  OF IT TO CORRESPONDING BAD CODE AND REMOVE FLAGS
    STRING BUF$, REMVCH, TBUF$, C$
    STRING BAD.CODES$, REP.CODES$, REP.CH$
    INTEGER I%, J%, REP.CAND%, BC%

    BAD.CODES$ = CHR$(10) + CHR$(13) + CHR$(26) + CHR$(34)
    REP.CODES$ = MID$(BUF$,1,4) :REM CODES WHICH REPLACED BAD CODES
    BUF$       = RIGHT$(BUF$,LEN(BUF$)-4) :REM REMOVE THE FLAGS

    FOR BC% = 1 TO 4
      IF MID$(REP.CODES$,BC%,1) = " " \
        THEN GOTO END.BC     :REM   NO PROBLEM - TRY THE NEXT ONE

      REP.CH$ = MID$(REP.CODES$,BC%,1)
      TBUF$   = ""

      FOR J% = 1 TO LEN(BUF$)
        C$ = MID$(BUF$,J%,1)
        IF REP.CH$ = C$ \    REPLACE WITH BAD CODE
          THEN TBUF$ = TBUF$ + MID$(BAD.CODES$,BC%,1) \ 
          ELSE TBUF$ = TBUF$ + C$
    NEXT J%
    BUF$ = TBUF$

 END.BC: NEXT BC%

    REMVCH = BUF$
    RETURN
FEND