svgamod1.bas

Quick Basic DOS Compilers

     
        '* CYAN
        OFST = 1 + (128 + NUMLEVELS * 2 + I) * 3
        MID$(PCXPAL, OFST + 0, 1) = CHR$(0)
        MID$(PCXPAL, OFST + 1, 1) = CHR$(63 - 35 * I / (NUMLEVELS - 1))
        MID$(PCXPAL, OFST + 2, 1) = CHR$(63 - 35 * I / (NUMLEVELS - 1))

        '* RED
        OFST = 1 + (128 + NUMLEVELS * 3 + I) * 3
        MID$(PCXPAL, OFST + 0, 1) = CHR$(63 - 35 * I / (NUMLEVELS - 1))
        MID$(PCXPAL, OFST + 1, 1) = CHR$(0)
        MID$(PCXPAL, OFST + 2, 1) = CHR$(0)

        '* MAGENTA
        OFST = 1 + (128 + NUMLEVELS * 4 + I) * 3
        MID$(PCXPAL, OFST + 0, 1) = CHR$(63 - 35 * I / (NUMLEVELS - 1))
        MID$(PCXPAL, OFST + 1, 1) = CHR$(0)
        MID$(PCXPAL, OFST + 2, 1) = CHR$(63 - 35 * I / (NUMLEVELS - 1))

        '* YELLOW
        OFST = 1 + (128 + NUMLEVELS * 5 + I) * 3
        MID$(PCXPAL, OFST + 0, 1) = CHR$(63 - 35 * I / (NUMLEVELS - 1))
        MID$(PCXPAL, OFST + 1, 1) = CHR$(63 - 35 * I / (NUMLEVELS - 1))
        MID$(PCXPAL, OFST + 2, 1) = CHR$(0)

        '* WHITE
        OFST = 1 + (128 + NUMLEVELS * 6 + I) * 3
        MID$(PCXPAL, OFST + 0, 1) = CHR$(63 - 35 * I / (NUMLEVELS - 1))
        MID$(PCXPAL, OFST + 1, 1) = CHR$(63 - 35 * I / (NUMLEVELS - 1))
        MID$(PCXPAL, OFST + 2, 1) = CHR$(63 - 35 * I / (NUMLEVELS - 1))
    NEXT I
    PALSET PCXPAL, 0, 255

    Colr = 0
    FOR A = 0 TO NUMOF
        X1 = RND * GETMAXX
        Y1 = RND * GETMAXY
        X2 = RND * GETMAXX
        Y2 = RND * GETMAXY
        DRWALINE INTSBITS, 128 + Colr * NUMLEVELS, X1, Y1, X2, Y2
        Colr = Colr + 1
        IF Colr > 6 THEN
            Colr = 0
        END IF
    NEXT A
    GETKEY RET$
    PALSET ORGPAL, 0, 255
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        SETVIEW 0, 0, GETMAXX, GETMAXY
        EXIT SUB
    END IF
 
    '*************************************************************************
    '* DRAW SOME BOXES
    '*************************************************************************
    SETVIEW 0, 0, GETMAXX, GETMAXY
    FILLSCREEN 0
    DRWSTRING 1, 7, 0, TITLE$, 10, 0
    A$ = "DRWBOX (Mode,Color,X1,Y1,X2,Y2)"
    DRWSTRING 1, 7, 0, A$, 10, 18
    SETVIEW 0, 32, GETMAXX, GETMAXY
    NUMOF = GETMAXX \ 10
    FOR A = 0 TO NUMOF
        X1 = RND * GETMAXX
        Y1 = RND * GETMAXY
        X2 = RND * GETMAXX
        Y2 = RND * GETMAXY
        DRWBOX 1, Colr, X1, Y1, X2, Y2
        Colr = Colr + 1
        IF Colr > 15 THEN
            Colr = 1
        END IF
    NEXT A
    GETKEY RET$
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        SETVIEW 0, 0, GETMAXX, GETMAXY
        EXIT SUB
    END IF

    '*************************************************************************
    '* DRAW SOME FILLED BOXES
    '*************************************************************************
    SETVIEW 0, 0, GETMAXX, GETMAXY
    FILLSCREEN 0
    DRWSTRING 1, 7, 0, TITLE$, 10, 0
    A$ = "DRWFILLBOX (Mode,Color,X1,Y1,X2,Y2)"
    DRWSTRING 1, 7, 0, A$, 10, 18
    SETVIEW 0, 32, GETMAXX, GETMAXY
    NUMOF = GETMAXX \ 15
    FOR A = 0 TO NUMOF
        X1 = RND * GETMAXX
        Y1 = RND * GETMAXY
        X2 = RND * GETMAXX
        Y2 = RND * GETMAXY
        DRWFILLBOX 1, Colr, X1, Y1, X2, Y2
        Colr = Colr + 1
        IF Colr > 15 THEN
            Colr = 1
        END IF
    NEXT A
    GETKEY RET$
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        SETVIEW 0, 0, GETMAXX, GETMAXY
        EXIT SUB
    END IF
 
    '*************************************************************************
    '* DRAW SOME CIRCLES
    '*************************************************************************
    SETVIEW 0, 0, GETMAXX, GETMAXY
    FILLSCREEN 0
    DRWSTRING 1, 7, 0, TITLE$, 10, 0
    A$ = "DRWCIRCLE (Mode,Color,Cx,Cy,Radius)"
    DRWSTRING 1, 7, 0, A$, 10, 18
    SETVIEW 0, 32, GETMAXX, GETMAXY
    NUMOF = GETMAXX \ 20
    MAXRAD = GETMAXX \ 2
    FOR A = 0 TO NUMOF
        X = RND * GETMAXX
        Y = RND * GETMAXY
        RAD = RND * MAXRAD
        DRWCIRCLE 1, Colr, X, Y, RAD
        Colr = Colr + 1
        IF Colr > 15 THEN
            Colr = 1
        END IF
    NEXT A
    GETKEY RET$
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        SETVIEW 0, 0, GETMAXX, GETMAXY
        EXIT SUB
    END IF

    '*************************************************************************
    '* DRAW SOME FILLED CIRCLES
    '*************************************************************************
    SETVIEW 0, 0, GETMAXX, GETMAXY
    FILLSCREEN 0
    DRWSTRING 1, 7, 0, TITLE$, 10, 0
    A$ = "DRWFILLCIRCLE (Mode,Color,Cx,Cy,Radius)"
    DRWSTRING 1, 7, 0, A$, 10, 18
    SETVIEW 0, 32, GETMAXX, GETMAXY
    NUMOF = GETMAXX \ 25
    MAXRAD = GETMAXX \ 2
    FOR A = 0 TO NUMOF
        X = RND * GETMAXX
        Y = RND * GETMAXY
        RAD = RND * MAXRAD
        DRWFILLCIRCLE 1, Colr, X, Y, RAD
        Colr = Colr + 1
        IF Colr > 15 THEN
            Colr = 1
        END IF
    NEXT A
    GETKEY RET$
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        SETVIEW 0, 0, GETMAXX, GETMAXY
        EXIT SUB
    END IF
 
    '*************************************************************************
    '* DRAW SOME ELLIPSES
    '*************************************************************************
    SETVIEW 0, 0, GETMAXX, GETMAXY
    FILLSCREEN 0
    DRWSTRING 1, 7, 0, TITLE$, 10, 0
    A$ = "DRWELLIPSE (Mode,Color,Cx,Cy,RadiusX,RadiusY)"
    DRWSTRING 1, 7, 0, A$, 10, 18
    SETVIEW 0, 32, GETMAXX, GETMAXY
    NUMOF = GETMAXX \ 20
    MAXRAD = GETMAXX \ 2
    FOR A = 0 TO NUMOF
        X = RND * GETMAXX
        Y = RND * GETMAXY + 35
        RADX = RND * MAXRAD
        RADY = RND * MAXRAD
        DRWELLIPSE 1, Colr, X, Y, RADX, RADY
        Colr = Colr + 1
        IF Colr > 15 THEN
            Colr = 1
        END IF
    NEXT A
    SETVIEW 0, 0, GETMAXX, GETMAXY
    GETKEY RET$
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        EXIT SUB
    END IF

    '*************************************************************************
    '* DRAW SOME FILLED ELLIPSES
    '*************************************************************************
    SETVIEW 0, 0, GETMAXX, GETMAXY
    FILLSCREEN 0
    DRWSTRING 1, 7, 0, TITLE$, 10, 0
    A$ = "DRWFILLELLIPSE (Mode,Color,Cx,Cy,RadiusX,RadiusY)"
    DRWSTRING 1, 7, 0, A$, 10, 18
    SETVIEW 0, 32, GETMAXX, GETMAXY
    NUMOF = GETMAXX \ 25
    MAXRAD = GETMAXX \ 2
    FOR A = 0 TO NUMOF
        X = RND * GETMAXX
        Y = RND * GETMAXY + 35
        RADX = RND * MAXRAD
        RADY = RND * MAXRAD
        DRWFILLELLIPSE 1, Colr, X, Y, RADX, RADY
        Colr = Colr + 1
        IF Colr > 15 THEN
            Colr = 1
        END IF
    NEXT A
    SETVIEW 0, 0, GETMAXX, GETMAXY
    GETKEY RET$
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        EXIT SUB
    END IF

    '*************************************************************************
    '* DRAW SOME CIRCLULAR ARCS
    '*************************************************************************
    SETVIEW 0, 0, GETMAXX, GETMAXY
    FILLSCREEN 0
    DRWSTRING 1, 7, 0, TITLE$, 10, 0
    A$ = "DRWCIRARC (Mode,Color,Cx,Cy,Radius,StartAng,EndAng)"
    DRWSTRING 1, 7, 0, A$, 10, 18
    SETVIEW 0, 32, GETMAXX, GETMAXY
    NUMOF = GETMAXX \ 20
    MAXRAD = GETMAXX \ 2
    FOR A = 0 TO NUMOF
        X = RND * GETMAXX
        Y = RND * GETMAXY
        RAD = RND * MAXRAD
        SANG = RND * 360
        EANG = RND * 360 + SANG
        DRWCIRARC 1, Colr, X, Y, RAD, SANG, EANG
        Colr = Colr + 1
        IF Colr > 15 THEN
            Colr = 1
        END IF
    NEXT A
    GETKEY RET$
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        SETVIEW 0, 0, GETMAXX, GETMAXY
        EXIT SUB
    END IF
 
    '*************************************************************************
    '* DRAW SOME ELLIPTICAL ARCS
    '*************************************************************************
    SETVIEW 0, 0, GETMAXX, GETMAXY
    FILLSCREEN 0
    DRWSTRING 1, 7, 0, TITLE$, 10, 0
    A$ = "DRWELLARC (Mode,Color,Cx,Cy,RadiusX,RadiusY,StartAng,EndAng)"
    DRWSTRING 1, 7, 0, A$, 10, 18
    SETVIEW 0, 32, GETMAXX, GETMAXY
    NUMOF = GETMAXX \ 20
    MAXRAD = GETMAXX \ 2
    FOR A = 0 TO NUMOF
        X = RND * GETMAXX
        Y = RND * GETMAXY + 35
        RADX = RND * MAXRAD
        RADY = RND * MAXRAD
        SANG = RND * 360
        EANG = RND * 360 + SANG
        DRWELLARC 1, Colr, X, Y, RADX, RADY, SANG, EANG
        Colr = Colr + 1
        IF Colr > 15 THEN
            Colr = 1
        END IF
    NEXT A
    SETVIEW 0, 0, GETMAXX, GETMAXY
    GETKEY RET$
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        EXIT SUB
    END IF

    '*************************************************************************
    '* DRAW SOME CUBIC BEZIER CURVES
    '*************************************************************************
    SETVIEW 0, 0, GETMAXX, GETMAXY
    FILLSCREEN 0
    DRWSTRING 1, 7, 0, TITLE$, 10, 0
    A$ = "DRWCUBICBEZIER (Mode,Color,Pon1,Poff1,Poff2,Pon2)"
    DRWSTRING 1, 7, 0, A$, 10, 18
    SETVIEW 0, 32, GETMAXX, GETMAXY
    NUMOF = GETMAXX \ 20
    FOR A = 0 TO NUMOF
        P1.X = RND * GETMAXX
        P1.Y = RND * GETMAXY
        OFF1.X = RND * GETMAXX
        OFF1.Y = RND * GETMAXY
        OFF2.X = RND * GETMAXX
        OFF2.Y = RND * GETMAXY
        P2.X = RND * GETMAXX
        P2.Y = RND * GETMAXY
        DRWCUBICBEZIER 1, Colr, P1.X, OFF1.X, OFF2.X, P2.X
        Colr = Colr + 1
        IF Colr > 15 THEN
            Colr = 1
        END IF
    NEXT A
    GETKEY RET$
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        SETVIEW 0, 0, GETMAXX, GETMAXY
        EXIT SUB
    END IF


    END SUB

    SUB DOSCROLL (RET$)
    DEFINT A-Z
    REM $DYNAMIC
 
    '*************************************************************************
    '* SET UP THE TITLE
    '*************************************************************************
    TITLE$ = "DEMO 7: Scrolling and Paging Functions"
    PALSET PAL, 0, 255
    FILLSCREEN 0
    SETVIEW 0, 0, GETMAXX, GETMAXY
    DRWSTRING 1, 7, 0, TITLE$, 10, 0

    SPCNG = (GETMAXY - 32) \ 5
    X1 = ((GETMAXX + 1) \ 2) - SPCNG
    Y1 = (((GETMAXY + 1 - 32) \ 2) + 32) - SPCNG
    X2 = ((GETMAXX + 1) \ 2) + SPCNG
    Y2 = (((GETMAXY + 1 - 32) \ 2) + 32) + SPCNG
    SKIP = SPCNG / 15
    Num = SPCNG / SKIP
    DRWBOX 1, 12, X1, Y1, X2, Y2
    X1 = X1 + 1
    Y1 = Y1 + 1
    X2 = X2 - 1
    Y2 = Y2 - 1
    Colr = 16
    TEXT$ = "TEXT text TEXT text TEXT"

    '*************************************************************************
    '* SHOW SCROLLUP
    '*************************************************************************
    SETVIEW 0, 0, GETMAXX, GETMAXY
    A$ = "SCROLLUP (X1,Y1,X2,Y2,NumLines,FillColr)"
    DRWSTRING 1, 7, 0, A$, 10, 16
    SETVIEW X1, Y1, X2, Y2
    FILLVIEW 0
    NUMOF = GETMAXX \ 10
    FOR A = 0 TO NUMOF
        X = RND * GETMAXX
        Y = RND * GETMAXY
        I = RND * GETMAXX
        J = RND * GETMAXY
        DRWLINE 1, Colr, X, Y, I, J
        Colr = Colr + 3