svgamod2.bas

Quick Basic DOS Compilers

    DRWSTRING 1, 7, 0, A$, 10, 32
    SETVIEW 0, 32, GETMAXX, GETMAXY
    FOR J = 0 TO 360 STEP 3
        D3ROTATE 10, 0, 0, 0, 0, J, J, POINTARRY3D(0).X, PLAYARRY(0).X
        R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
        SHOWHOUSE
        SDELAY 2
    NEXT J
    GETKEY RET$
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        FILLSCREEN 0
        SETVIEW 0, 0, GETMAXX, GETMAXY
        EXIT SUB
    END IF



    END SUB

    SUB DOJOYSTICK (RET$)
    DEFINT A-Z
    REM $DYNAMIC
 
    '*************************************************************************
    '* SET UP THE TITLE
    '*************************************************************************
    TITLE$ = "DEMO 10: Joystick functions"
    PALSET PAL, 0, 255
    FILLSCREEN 0
    SETVIEW 0, 0, GETMAXX, GETMAXY

    '*************************************************************************
    '* CHECK TO SEE IF WE HAVE A JOYSTICK SO WE CAN DO THE JOYSTICK DEMO
    '*************************************************************************
    JOYSTICK = WHICHJOYSTICK
    IF JOYSTICK < 1 THEN
        SOUND 100, 5
        DRWSTRING 1, 7, 0, TITLE$, 10, 0
        A$ = "Sorry, No Joystick Detected..."
        DRWSTRING 1, 7, 0, A$, 10, 16
        A$ = "Can Not Do The Joystick Demo."
        DRWSTRING 1, 7, 0, A$, 10, 32
        A$ = "Press A Key..."
        DRWSTRING 1, 15, 0, A$, 10, 48
        WHILE INKEY$ = ""
        WEND
        FILLSCREEN 0
        EXIT SUB
    END IF

    '*************************************************************************
    '* SHOW JOYSTICKINFO (HERE WE DO SOME JOYSTICK CALIBRATION)
    '*************************************************************************
    DRWSTRING 1, 7, 0, TITLE$, 10, 0
    A$ = "JOYSTICKINFO (JAX,JAY,JAButs,JBX,JBY,JBButs)"
    DRWSTRING 1, 7, 0, A$, 10, 16
    SETVIEW 0, 0, GETMAXX, GETMAXY
    SELECT CASE JOYSTICK
        CASE IS = 1
            A$ = "Please Move Joystick A As Far As It Will Go In All Directions"
        CASE IS = 2
            A$ = "Please Move Joystick B As Far As It Will Go In All Directions"
        CASE IS = 3
            A$ = "Please Move Both Joystick A And B As Far As They Will Go In All Directions"
    END SELECT
    DRWSTRING 1, 7, 0, A$, 10, 32
    A$ = "And Then Press A Key..."
    DRWSTRING 1, 7, 0, A$, 10, 48
    SOUND 700, .75
    GETMAXXA = -1
    MAXYA = -1
    MINXA = 10000
    MINYA = 10000
    GETMAXXB = -1
    MAXYB = -1
    MINXB = 10000
    MINYB = 10000
    A$ = ""
    WHILE A$ = ""
        JOYSTICKINFO JAX, JAY, JAButs, JBX, JBY, JBButs
        IF JAX > GETMAXXA THEN
            GETMAXXA = JAX
        END IF
        IF JAX < MINXA THEN
            MINXA = JAX
        END IF
        IF JAY > MAXYA THEN
            MAXYA = JAY
        END IF
        IF JAY < MINYA THEN
            MINYA = JAY
        END IF
        IF JBX > GETMAXXB THEN
            GETMAXXB = JBX
        END IF
        IF JBX < MINXB THEN
            MINXB = JBX
        END IF
        IF JBY > MAXYB THEN
            MAXYB = JBY
        END IF
        IF JBY < MINYB THEN
            MINYB = JBY
        END IF
        A$ = INKEY$
    WEND

    '*************************************************************************
    '* CALCULATE THE CENTER AND STUFF...
    '*************************************************************************
    SPCNG = GETMAXX \ 7
    DIST = SPCNG * 2
    X1 = SPCNG \ 2
    Y1 = SPCNG \ 2 + 32
    X2 = X1 + DIST
    Y2 = Y1 + DIST
    X4 = GETMAXX - SPCNG
    Y4 = Y2
    X3 = X4 - DIST
    Y3 = Y1
    CNTAX = (X2 - X1) / 2 + X1
    CNTAY = (Y2 - Y1) / 2 + Y1
    CNTBX = (X4 - X3) / 2 + X3
    CNTBY = (Y4 - Y3) / 2 + Y3
    RANGEXA = GETMAXXA - MINXA
    RANGEYA = MAXYA - MINYA
    RANGEXB = GETMAXXB - MINXB
    RANGEYB = MAXYB - MINYB
    JABAX = (X2 - X1) \ 4 + X1 - 16
    JABAY = (SPCNG \ 4) + Y2 - 6
    JABBX = X2 - (X2 - X1) \ 4 - 16
    JABBY = (SPCNG \ 4) + Y2 - 6
    JBBAX = (X4 - X3) \ 4 + X3 - 16
    JBBAY = (SPCNG \ 4) + Y4 - 6
    JBBBX = X4 - (X4 - X3) \ 4 - 16
    JBBBY = (SPCNG \ 4) + Y4 - 6

    '*************************************************************************
    '* LETS MOVE IT (OR THEM) AROUND
    '*************************************************************************
    SETVIEW 0, 0, GETMAXX, 64
    FILLVIEW 0
    SETVIEW 0, 0, GETMAXX, GETMAXY
    IF JOYSTICK AND 1 THEN
        DRWBOX 1, 15, X1 - 1, Y1 - 1, X2 + 1, Y2 + 1
        DRWBOX 1, 15, X1 - 1, Y2 + 1, X2 + 1, Y2 + SPCNG \ 2
        DRWLINE 1, 15, (X2 - X1) \ 2 + X1, Y2 + 1, (X2 - X1) \ 2 + X1, Y2 + SPCNG \ 2
        OAX = CNTAX
        OAY = CNTAY
        DRWLINE 1, 10, CNTAX, CNTAY, OAX, OAY
    ELSE
        DRWBOX 1, 8, X1 - 1, Y1 - 1, X2 + 1, Y2 + 1
        DRWBOX 1, 8, X1 - 1, Y2 + 1, X2 + 1, Y2 + SPCNG \ 2
        DRWLINE 1, 8, (X2 - X1) \ 2 + X1, Y2 + 1, (X2 - X1) \ 2 + X1, Y2 + SPCNG \ 2
    END IF
    IF JOYSTICK AND 2 THEN
        DRWBOX 1, 15, X3 - 1, Y3 - 1, X4 + 1, Y4 + 1
        DRWBOX 1, 15, X3 - 1, Y4 + 1, X4 + 1, Y4 + SPCNG \ 2
        DRWLINE 1, 15, (X4 - X3) \ 2 + X3, Y4 + 1, (X4 - X3) \ 2 + X3, Y4 + SPCNG \ 2
        OBX = CNTBX
        OBY = CNTBY
        DRWLINE 1, 10, CNTBX, CNTBY, OBX, OBY
    ELSE
        DRWBOX 1, 8, X3 - 1, Y3 - 1, X4 + 1, Y4 + 1
        DRWBOX 1, 8, X3 - 1, Y3 + 1, X4 + 1, Y4 + SPCNG \ 2
        DRWLINE 1, 8, (X4 - X3) \ 2 + X3, Y4 + 1, (X4 - X3) \ 2 + X3, Y4 + SPCNG \ 2
    END IF
    DRWSTRING 1, 7, 0, TITLE$, 10, 0
    A$ = "JOYSTICKINFO (JAX,JAY,JAButs,JBX,JBY,JBButs)"
    DRWSTRING 1, 7, 0, A$, 10, 16
    SETVIEW 0, 32, GETMAXX, GETMAXY
    A$ = ""
    WHILE A$ = ""
        JOYSTICKINFO JAX, JAY, JAButs, JBX, JBY, JBButs
        IF JOYSTICK AND 1 THEN
            SETVIEW X1, Y1, X2, Y2
            JAX = JAX - MINXA
            JAX = JAX / RANGEXA * DIST + X1
            JAY = JAY - MINYA
            JAY = JAY / RANGEYA * DIST + Y1
            DRWLINE 1, 0, CNTAX, CNTAY, OAX, OAY
            OAX = JAX
            OAY = JAY
            DRWLINE 1, 10, CNTAX, CNTAY, OAX, OAY
            SETVIEW 0, 0, GETMAXX, GETMAXY
            IF JAButs AND 1 THEN
                DRWSTRING 1, 10, 0, "ButA", JABAX, JABAY
            ELSE
                DRWSTRING 1, 8, 0, "ButA", JABAX, JABAY
            END IF
            IF JAButs AND 2 THEN
                DRWSTRING 1, 10, 0, "ButB", JABBX, JABBY
            ELSE
                DRWSTRING 1, 8, 0, "ButB", JABBX, JABBY
            END IF
        END IF
        IF JOYSTICK AND 2 THEN
            SETVIEW X3, Y3, X4, Y4
            JBX = JBX - MINXB
            JBX = JBX / RANGEXB * DIST + X3
            JBY = JBY - MINYB
            JBY = JBY / RANGEYB * DIST + Y3
            DRWLINE 1, 0, CNTBX, CNTBY, OBX, OBY
            OBX = JBX
            OBY = JBY
            DRWLINE 1, 10, CNTBX, CNTBY, OBX, OBY
            SETVIEW 0, 0, GETMAXX, GETMAXY
            IF JBButs AND 1 THEN
                DRWSTRING 1, 10, 0, "ButA", JBBAX, JBBAY
            ELSE
                DRWSTRING 1, 8, 0, "ButA", JBBAX, JBBAY
            END IF
            IF JBButs AND 2 THEN
                DRWSTRING 1, 10, 0, "ButB", JBBBX, JBBBY
            ELSE
                DRWSTRING 1, 8, 0, "ButB", JBBBX, JBBBY
            END IF
        END IF
        A$ = INKEY$
    WEND
    RET$ = A$
    IF RET$ = "q" THEN
        RET$ = "Q"
    END IF
    IF RET$ = "s" THEN
        RET$ = "S"
    END IF
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        FILLSCREEN 0
        SETVIEW 0, 0, GETMAXX, GETMAXY
        EXIT SUB
    END IF

    SETVIEW 0, 0, GETMAXX, GETMAXY

    END SUB

    SUB DOMOUSE (RET$)
    DEFINT A-Z
    REM $DYNAMIC
 
    '*************************************************************************
    '* SET UP THE TITLE
    '*************************************************************************
    TITLE$ = "DEMO 9: Mouse functions"
    FILLSCREEN 0
    PALSET PAL, 0, 255
    SETVIEW 0, 0, GETMAXX, GETMAXY

    '*************************************************************************
    '* CHECK TO SEE IF WE HAVE A MOUSE SO WE CAN DO THE MOUSE DEMO
    '*************************************************************************
    MOUSE = WHICHMOUSE
    IF MOUSE < 1 THEN
        SOUND 100, 5
        DRWSTRING 1, 7, 0, TITLE$, 10, 0
        A$ = "Sorry, No Mouse Detected..."
        DRWSTRING 1, 7, 0, A$, 10, 16
        A$ = "Can Not Do The Mouse Demo."
        DRWSTRING 1, 7, 0, A$, 10, 32
        A$ = "Press A Key..."
        DRWSTRING 1, 15, 0, A$, 10, 48

        WHILE INKEY$ = ""
        WEND
        FILLSCREEN 0
        EXIT SUB
    ELSE
        Colr = 16
        FOR I = 0 TO GETMAXX \ 2
            DRWCIRCLE 1, Colr, GETMAXX \ 4 + I, GETMAXY \ 2, GETMAXY \ 5
            Colr = Colr + 2
            IF Colr > 255 THEN
                Colr = 16
            END IF
        NEXT I
    END IF

    '*************************************************************************
    '* SHOW MOUSESHOW
    '*************************************************************************
    SETVIEW 0, 0, GETMAXX, 31
    FILLVIEW 0
    DRWSTRING 1, 7, 0, TITLE$, 10, 0
    A$ = "MOUSESHOW ()"
    DRWSTRING 1, 7, 0, A$, 10, 16
    SETVIEW 0, 32, GETMAXX, GETMAXY
    MOUSEENTER '*MUST BE CALLED FIRST TO ENABLE MOUSE FUNCTIONS
    MOUSESHOW
    GETKEY RET$
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
        FILLSCREEN 0
        SETVIEW 0, 0, GETMAXX, GETMAXY
        EXIT SUB
    END IF

    '*************************************************************************
    '* SHOW MOUSESTATUS
    '*************************************************************************
    MOUSEHIDE
    SETVIEW 0, 0, GETMAXX, 31
    FILLVIEW 0
    DRWSTRING 1, 7, 0, TITLE$, 10, 0
    A$ = "MOUSESTATUS (Xloc,Yloc,MButs)"
    DRWSTRING 1, 7, 0, A$, 10, 16
    MOUSESHOW
    SETVIEW 0, 32, GETMAXX, GETMAXY
    A$ = ""
    SOUND 700, .75
    WHILE A$ = ""
        MOUSESTATUS X, Y, MButs
        IF MButs AND 1 THEN
            LB = 1
        ELSE
            LB = 0
        END IF
        IF MButs AND 2 THEN
            RB = 1
        ELSE
            RB = 0
        END IF
        IF MButs AND 4 THEN
            CB = 1
        ELSE
            CB = 0
        END IF
        D$ = "X=" + STR$(X)
        L = LEN(D$)
        IF L < 10 THEN
            D$ = D$ + STRING$(8 - L, 32)
        END IF
        D$ = D$ + "Y=" + STR$(Y)
        L = LEN(D$)
        IF L < 20 THEN
            D$ = D$ + STRING$(16 - L, 32)
        END IF
        D$ = D$ + "LB=" + STR$(LB) + "  CB=" + STR$(CB) + "  RB=" + STR$(RB)
        DRWSTRING 1, 15, 8, D$, 10, 32
        A$ = INKEY$
    WEND
    RET$ = A$
    IF RET$ = "q" THEN
        RET$ = "Q"
    END IF
    IF RET$ = "s" THEN
        RET$ = "S"
    END IF
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
        FILLSCREEN 0
        SETVIEW 0, 0, GETMAXX, GETMAXY
        EXIT SUB
    END IF

    '*************************************************************************
    '* SHOW MOUSEHIDE
    '*************************************************************************
    MOUSEHIDE
    SETVIEW 0, 0, GETMAXX, 31
    FILLVIEW 0
    SETVIEW 0, 0, GETMAXX, GETMAXY
    DRWSTRING 1, 7, 0, TITLE$, 10, 0
    A$ = "MOUSEHIDE ()"
    DRWSTRING 1, 7, 0, A$, 10, 16
    SETVIEW 0, 32, GETMAXX, GETMAXY
    A$ = ""
    SOUND 700, .75
    WHILE A$ = ""
        MOUSESTATUS X, Y, MButs
        IF MButs AND 1 THEN
            LB = 1
        ELSE
            LB = 0
        END IF
        IF MButs AND 2 THEN
            RB = 1
        ELSE
            RB = 0
        END IF
        IF MButs AND 4 THEN
            CB = 1
        ELSE
            CB = 0
        END IF
        D$ = "X=" + STR$(X)
        L = LEN(D$)
        IF L < 10 THEN
            D$ = D$ + STRING$(8 - L, 32)
        END IF
        D$ = D$ + "Y=" + STR$(Y)
        L = LEN(D$)
        IF L < 20 THEN
            D$ = D$ + STRING$(16 - L, 32)
        END IF
        D$ = D$ + "LB=" + STR$(LB) + "  CB=" + STR$(CB) + "  RB=" + STR$(RB)
        DRWSTRING 1, 15, 8, D$, 10, 32
        A$ = INKEY$
    WEND
    MOUSESHOW
    RET$ = A$
    IF RET$ = "q" THEN
        RET$ = "Q"
    END IF
    IF RET$ = "s" THEN
        RET$ = "S"
    END IF
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
        FILLSCREEN 0
        SETVIEW 0, 0, GETMAXX, GETMAXY
        EXIT SUB
    END IF

    '*************************************************************************
    '* SHOW MOUSERANGESET