Ray Tracing Box/RAY_CD.mdf/ray_util/showpic/john_sub.bas

BASIC Source File | 1994-02-10 | 5KB | 215 lines

'*****************************JOHN_SUB.BAS********************************
'JOHN :
'Trying to get modular
'This contains the subs and functions I use all the time
'2/7/94
'
'There is no main module in this *.BAS file.

'Declarations for Routines in JOHN_SUB.BAS
DEFINT A-Z
DECLARE SUB LocateIt (Row%, text$)
DECLARE SUB ColorIt (Fgd%, Bkg%)
DECLARE FUNCTION Center% (text$)
DECLARE SUB CursorOff ()
DECLARE SUB CursorOn ()
DECLARE SUB Pause (Seconds!)
DECLARE SUB ErrorBox (Row%)
DECLARE SUB TextBox (Row%, Col%, Message$, Outline%, Length%)
DECLARE SUB Waitkey ()
DECLARE SUB WidenMsg (MsgLength%, Message$)

Copyright$ = "■Copyright (c) 1994 ■ John De Palma■"

FUNCTION Center% (text$)
Center% = 41 - LEN(text$) \ 2
END FUNCTION

SUB ColorIt (Fgd, Bkg)
COLOR Fgd, Bkg
END SUB

SUB CursorOff
LOCATE , , 0
END SUB

SUB CursorOn
LOCATE , , 1, 4, 7
END SUB

SUB ErrorBox (Row%)

CALL ColorIt(15, 4)

text$ = "█▀▀▀▀▀▀▀▀▀▀▀▀▀█"
CALL LocateIt(Row%, text$)
text$ = "█    ERROR    █"
CALL LocateIt(Row% + 1, text$)
text$ = "█▄▄▄▄▄▄▄▄▄▄▄▄▄█"
CALL LocateIt(Row% + 2, text$)

END SUB

SUB LocateIt (Row%, text$)
LOCATE Row%, Center(text$)
PRINT text$;
END SUB

DEFSNG A-Z
SUB Pause (Seconds!)

    Synch! = TIMER
    DO                          'looping changes the Start! time to
        Start! = TIMER          'synchronize to the system timer
    LOOP WHILE Start! = Synch!  'Seconds! must be SINGLE to get fractions
                                'of a second
    DO
        Kee$ = INKEY$
    LOOP UNTIL TIMER > (Start! + Seconds!) OR LEN(Kee$)

                                'put Kee$ in just in case we pass midnight
    WHILE INKEY$ <> "": WEND    'delete that key stroke
END SUB

DEFINT A-Z
SUB TextBox (Row%, Col%, Message$, Outline%, Length%)

    'Will put a message into a three line box -or-
    'draw a box without a message using Message$=SPACE$(x)
    'where "x" is the width of the box and Length%= number of lines > 3
    'All boxes are centered.
    'Now to make them non centered....

    Message$ = LEFT$(Message$, 60)
    BoxWidth% = LEN(Message$) + 4
    SELECT CASE Outline%
        CASE 0
            j = 8 * 5 + 1
        CASE 1
            j = 1
        CASE 2
            j = 8 + 1
        CASE 3
            j = 8 * 2 + 1
        CASE 4
            j = 8 * 3 + 1
        CASE 5
            j = 8 * 4 + 1
        CASE ELSE
            j = 8 * 5 + 1
    END SELECT

    DIM Box$(1 TO 8 * 6)

'single line box
    Box$(1) = "┌"
    Box$(2) = "─"
    Box$(3) = "┐"
    Box$(4) = "│"
    Box$(5) = "│"
    Box$(6) = "└"
    Box$(7) = "─"
    Box$(8) = "┘"

'double top box
    Box$(9) = "╒"
    Box$(10) = "═"
    Box$(11) = "╕"
    Box$(12) = "│"
    Box$(13) = "│"
    Box$(14) = "╘"
    Box$(15) = "═"
    Box$(16) = "╛"

'double side box
    Box$(17) = "╓"
    Box$(18) = "─"
    Box$(19) = "╖"
    Box$(20) = "║"
    Box$(21) = "║"
    Box$(22) = "╙"
    Box$(23) = "─"
    Box$(24) = "╜"

'double box
    Box$(25) = "╔"
    Box$(26) = "═"
    Box$(27) = "╗"
    Box$(28) = "║"
    Box$(29) = "║"
    Box$(30) = "╚"
    Box$(31) = "═"
    Box$(32) = "╝"

'bold and thick box
    Box$(33) = "█"
    Box$(34) = "▀"
    Box$(35) = "█"
    Box$(36) = "█"
    Box$(37) = "█"
    Box$(38) = "█"
    Box$(39) = "▄"
    Box$(40) = "█"

'no box
    Box$(41) = " "
    Box$(42) = " "
    Box$(43) = " "
    Box$(44) = " "
    Box$(45) = " "
    Box$(46) = " "
    Box$(47) = " "
    Box$(48) = " "

    IF Col% = 0 THEN

        BoxText$ = Box$(j) + STRING$(BoxWidth%, Box$(j + 1)) + Box$(j + 2)
        CALL LocateIt(Row%, BoxText$)

        FOR i = 1 TO Length% + 1
        BoxText$ = Box$(j + 3) + "  " + Message$ + "  " + Box$(j + 4)
        CALL LocateIt(Row% + i, BoxText$)
        NEXT i

        BoxText$ = Box$(j + 5) + STRING$(BoxWidth%, Box$(j + 6)) + Box$(j + 7)
        CALL LocateIt(Row% + i, BoxText$)

    ELSE

        BoxText$ = Box$(j) + STRING$(BoxWidth%, Box$(j + 1)) + Box$(j + 2)
        LOCATE Row%, Col%
        PRINT BoxText$

        FOR i = 1 TO Length% + 1
        BoxText$ = Box$(j + 3) + "  " + Message$ + "  " + Box$(j + 4)
        LOCATE Row% + i, Col%
        PRINT BoxText$
        NEXT i

        BoxText$ = Box$(j + 5) + STRING$(BoxWidth%, Box$(j + 6)) + Box$(j + 7)
        LOCATE Row% + i, Col%
        PRINT BoxText$

    END IF
END SUB

SUB Waitkey

    WHILE INKEY$ <> "": WEND
    DO
        Kee$ = INKEY$
    LOOP UNTIL LEN(Kee$)
    IF Kee$ = CHR$(27) THEN END

END SUB

SUB WidenMsg (MsgLength%, Message$)
Length% = LEN(Message$)
WHILE Length% < MsgLength%
    Message$ = " " + Message$ + " "
    Length% = LEN(Message$)
WEND

END SUB