CP/M/CPM_CDROM.iso/lambda/soundpot/p/reliance.lbr/MODLIB.BZS/MODLIB.BAS

BASIC Source File | 1993-10-25 | 6.1 KB | 281 lines

REM --- MODLIB.BAS
COMMENT
    *******************************************************
    *    This Include module contains procedures       *
    *    common to several Reliance Software Services  *
    *       programs                                      *
    *******************************************************
END

$MODULE GLOBALS
REM    Global variables and constants

VAR    Q$ = STRING        ;String returned by proc GET.STRING
VAR    ANS = BYTE        ;For user answer to Y/N question
VAR    QNEXT,QPREV,QESC = BYTE ;Booleans for whether key was pressed
VAR    MININT = INTEGER    ;Constant -- minimum integer value
VAR    BEL = BYTE        ;Constant
    BEL = CHR$(7)        ;Audible tone

$CONSTANT    MAXINT = 32767        ;Maximum integer value
    MININT = MAXINT * -1
$CONSTANT    NEXT.LINE = 0AH        ;Down-arrow key on Kaypro
$CONSTANT    PREV.LINE = 0BH        ;Up-arrow key on Kaypro
$CONSTANT    ESCAPE = 1BH        ;ASCII for Escape
$CONSTANT    CARR.RTN = 0DH        ;ASCII for Carriage Return
$CONSTANT    BKSPACE = 08H        ;ASCII for Backspace
$CONSTANT    DEL = 7FH        ;ASCII for Delete
$END.MODULE

$MODULE PUT.CURSOR
PROCEDURE PUT.CURSOR (ROW,COL=INTEGER)
    REM -- Place cursor at row (0 - 23) and column (0 - 79) specified
    PRINT #0; CHR$(27)+"="+CHR$(ROW+32)+CHR$(COL+32);
END
$END.MODULE

$MODULE WRITESTR
PROCEDURE WRITESTR (STR = STRING ; ROW, COL = INTEGER)
    PUT.CURSOR ROW,COL
    PRINT #0; STR;
END
$END.MODULE

$MODULE CLEAR.SCREEN
PROCEDURE CLEAR.SCREEN
    PRINT #0;CHR$(26);
END
$END.MODULE

$MODULE READ.BOOL
PROCEDURE READ.BOOL (ROW, COL = INTEGER)
COMMENT
    Inputs "Y" or "N" to global variable ANS at row & col specified
    Prints "YES" or "NO"
END
$LIST OFF
    PUT.CURSOR ROW, COL
    PRINT #0; SPC(3);
    PUT.CURSOR ROW, COL
    ECHO OFF
    REPEAT
        INPUT3 ANS
    UNTIL ANS = 'Y' OR ANS = 'N' OR ANS = 'y' OR ANS = 'n'
    ECHO ON
    IF ANS THEN
        PRINT #0; "YES";
    ELSE
        PRINT #0; "NO";
END
$LIST ON
$END.MODULE

$MODULE PAUSE
PROCEDURE PAUSE
    REM --- Prints message on line 23, waits for user response
    REM     Requires line 23 to be available, uses proc PUT.CURSOR
$LIST OFF
    VAR    P.ANS    = BYTE

    PUT.CURSOR 23,20
    PRINT #0; "PRESS <RETURN> TO CONTINUE";
    ECHO OFF
    REPEAT
        INPUT3 P.ANS
    UNTIL P.ANS = 0DH
    ECHO ON
    PUT.CURSOR 23,20
    PRINT #0; SPC(27);

END    ; END PROCEDURE PAUSE
$LIST ON
$END.MODULE

$MODULE BUILD.UC.STRING
VAR UC.STRING    = STRING:127
DIM BASE BYTE    UC.ARRAY(127)
VAR UC.ADDR    = INTEGER

PROCEDURE BUILD.UC.STRING
COMMENT
    This builds a string of all the ASCII codes except where the
    lower case letters should be, put upper case letters.
    This string will be used with the XLATE function to translate
    lower case to upper case.
END
    VAR N = INTEGER        ; LOOP CONTROL

    REM --- Position array over string
    LOCATION VAR UC.ADDR = UC.STRING
    LOCATE UC.ARRAY AT UC.ADDR

    REM --- Build string of all the ASCII codes except 00H
    FOR N = 1 TO 96
        UC.ARRAY(N) = CHR$(N)
    NEXT N

    REM --- Make lower case upper case instead
    FOR N = 97 TO 122
        UC.ARRAY(N) = CHR$(N-20H)
    NEXT N

    REM --- Finish up ASCII codes
    FOR N = 123 TO 127
        UC.ARRAY(N) = CHR$(N)
    NEXT N
END    ; END PROC=BUILD.UC.STRING
$END.MODULE

$MODULE MAKE.UPPER.CASE
FUNCTION MAKE.UPPER.CASE (SOURCE = STRING) = STRING
    VAR DEST = STRING
    DEST = XLATE (SOURCE,UC.STRING)
END = DEST    ; END FUNCTION=MAKE.UPPER.CASE
$END.MODULE

$MODULE GET.STRING
PROCEDURE GET.STRING (ROW,COL,MAXLEN=INTEGER;KIND=BYTE;INITIAL=STRING)
    COMMENT
        This procedure gets input from the keyboard one character
        at a time and edits on the fly, rejecting invalid characters.
        ROW and COL tell where to put beginning of data input line.
        MAXLEN is max length of string to be returned.
        KIND is what kind of input to be returned:
        "S" -- return STRING, Q$
        "N" -- return STRING, Q$ with numeric value
        INITIAL is initial value of string.
    END
$LIST OFF
    REM ----------- LOCAL VARIABLES ---------------------------------

    VAR    QIPT=BYTE    ; Input one character at a time
    VAR    QLEN=INTEGER    ; Length of string
    VAR    TMQ$=STRING    ; Work area for adjusting string length

    REM ----------- INITIALIZATION ----------------------------------

    Q$=INITIAL
    QLEN=LEN(Q$)
    QNEXT='N'
    QPREV='N'
    QESC='N'

    PUT.CURSOR ROW,COL
    PRINT Q$;STRING$(MAXLEN-LEN(Q$),2EH)
    PUT.CURSOR ROW,COL+LEN(Q$)
    ECHO OFF

    REM ----------- BEGIN MAIN LOOP OF GET.STRING ---------------

0GET1    INPUT3 QIPT

    IF QIPT=CARR.RTN THEN 0GET9    ; If carriage return, exit

    IF QIPT=NEXT.LINE THEN
        BEGIN
        QNEXT='Y'
        GOTO 0GET9
        END

    IF QIPT=PREV.LINE THEN
        BEGIN
        QPREV='Y'
        GOTO 0GET9
        END

    IF QIPT=ESCAPE THEN
        BEGIN
        QESC='Y'
        GOTO 0GET9
        END

    IF QIPT=BKSPACE OR QIPT=DEL THEN
        BEGIN
        GOSUB 0GET7        ; Subrtn to backspace
        GOTO 0GET1
        END

    IF QIPT<' ' OR QIPT>'~' THEN \    ; See if character is printable
        BEGIN
        PRINT BEL;
        GOTO 0GET1
        END

    IF QLEN=MAXLEN THEN
        BEGIN
        PRINT BEL;
        GOTO 0GET1
        END

    IF KIND='S' THEN
        BEGIN
        GOSUB 0GET8        ; Subrtn to concatenate
        GOTO 0GET1
        END

    IF KIND='N' THEN
        BEGIN
        IF QIPT<'0' \
        OR QIPT>'9' THEN
            PRINT BEL;
        ELSE
            GOSUB 0GET8    ; Subrtn to concatenate
        GOTO 0GET1
        END

0GET7
    REM --- Subroutine to process backspace
    IF QLEN = 0 THEN
        PRINT BEL;
    ELSE
        BEGIN
        PRINT CHR$(8);".";CHR$(8);
        QLEN=QLEN-1
        TMQ$=LEFT$(Q$,QLEN)
        Q$=TMQ$
        END
    RETURN

0GET8    Q$=Q$+QIPT            ; Concatenate byte to build string
    QLEN=QLEN+1
    PRINT QIPT;
    RETURN

0GET9   ECHO ON

END                    ; END PROCEDURE GET.STRING
$LIST ON
$END.MODULE

$MODULE PURGE.CHAR
FUNCTION PURGE.CHAR(INS=STRING;INC=CHAR)=STRING
    REM -- Purges all instances of the character from the string
$LIST OFF
    VAR N1=INTEGER        ;COUNTER
    VAR OUTS=STRING        ;RESULT STRING
    OUTS=""
    FOR N1=1 TO LEN(INS)
        BEGIN
        IF MID$(INS,N1,1)<>INC THEN
            OUTS=OUTS+MID$(INS,N1,1)
        END
    NEXT
END=OUTS
$LIST ON
$END.MODULE

$MODULE STRIP.CHAR
FUNCTION STRIP.CHAR(INS=STRING;INC=CHAR)=STRING
    REM -- Strips leading instances of the character from the string
$LIST OFF
    VAR WKS=STRING
    WHILE LEFT$(INS,1)=INC DO
        BEGIN
        WKS=RIGHT$(INS,LEN(INS)-1)
        INS=WKS
        END
END=INS
$LIST ON
$END.MODULE
0GET7
    REM ---