svgamod1.bas

Quick Basic DOS Compilers

    SPCINGY = ((GETMAXY + 1 - 35) - HGTH * 2) / 3
    XINC = WDTH * 1.5
    YINC = HGTH * 1.5
    XSUB = WDTH * .25
    YSUB = HGTH * .25

    B1X1 = SPCINGX
    B1X2 = B1X1 + WDTH
    B1Y1 = SPCINGY + 35
    B1Y2 = B1Y1 + HGTH

    B2X2 = GETMAXX - SPCINGX
    B2X1 = B2X2 - WDTH
    B2Y1 = SPCINGY + 35
    B2Y2 = B2Y1 + HGTH

    B3X2 = GETMAXX - SPCINGX
    B3X1 = B3X2 - WDTH
    B3Y2 = GETMAXY - SPCINGY
    B3Y1 = B3Y2 - HGTH

    B4X1 = SPCINGX
    B4X2 = B4X1 + WDTH
    B4Y2 = GETMAXY - SPCINGY
    B4Y1 = B4Y2 - HGTH

    DRWBOX 1, 15, B1X1, B1Y1, B1X2, B1Y2
    DRWBOX 1, 15, B2X1, B2Y1, B2X2, B2Y2
    DRWBOX 1, 15, B3X1, B3Y1, B3X2, B3Y2
    DRWBOX 1, 15, B4X1, B4Y1, B4X2, B4Y2

    B1X1 = B1X1 + 1
    B1Y1 = B1Y1 + 1
    B1X2 = B1X2 - 1
    B1Y2 = B1Y2 - 1

    B2X1 = B2X1 + 1
    B2Y1 = B2Y1 + 1
    B2X2 = B2X2 - 1
    B2Y2 = B2Y2 - 1

    B3X1 = B3X1 + 1
    B3Y1 = B3Y1 + 1
    B3X2 = B3X2 - 1
    B3Y2 = B3Y2 - 1

    B4X1 = B4X1 + 1
    B4Y1 = B4Y1 + 1
    B4X2 = B4X2 - 1
    B4Y2 = B4Y2 - 1

    GETKEY RET$
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        SETVIEW 0, 0, GETMAXX, GETMAXY
        EXIT SUB
    END IF

    SETVIEW B1X1, B1Y1, B1X2, B1Y2
    FILLVIEW (10)
    SETVIEW B2X1, B2Y1, B2X2, B2Y2
    FILLVIEW (12)
    SETVIEW B3X1, B3Y1, B3X2, B3Y2
    FILLVIEW (13)
    SETVIEW B4X1, B4Y1, B4X2, B4Y2
    FILLVIEW (14)

    SETVIEW 0, 0, GETMAXX, GETMAXY
    GETKEY RET$
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        SETVIEW 0, 0, GETMAXX, GETMAXY
        EXIT SUB
    END IF

    '*************************************************************************
    '* SET UP WINDOW AND SHOW AREA FILL
    '*************************************************************************
    FILLSCREEN 0
    DRWSTRING 1, 7, 0, TITLE$, 10, 0
    A$ = "FILLAREA (Xseed,Yseed,BrdrCol,FilCol)"
    DRWSTRING 1, 7, 0, A$, 10, 16

    DRWBOX 1, 15, 5, 35, GETMAXX - 4, GETMAXY - 4
    SETVIEW 6, 36, GETMAXX - 5, GETMAXY - 5

    Colr = 1
    FOR I = 0 TO GETMAXX \ 10
        X = 50 + RND * (GETMAXX - 50)
        Y = 50 + RND * (GETMAXY - 50)
        RADX = 2 + RND * GETMAXX \ 20
        RADY = 2 + RND * GETMAXX \ 20
        DRWELLIPSE 1, Colr, X, Y, RADX, RADY
        Colr = Colr + 1
        IF Colr > 9 THEN
            Colr = 1
        END IF
    NEXT I

    FOR I = 0 TO GETMAXX \ 15
        X = 50 + RND * (GETMAXX - 50)
        Y = 50 + RND * (GETMAXY - 50)
        RADX = 2 + RND * GETMAXX \ 20
        RADY = 2 + RND * GETMAXX \ 20
        DRWELLIPSE 1, 12, X, Y, RADX, RADY
    NEXT I

    GETKEY RET$
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        SETVIEW 0, 0, GETMAXX, GETMAXY
        EXIT SUB
    END IF
    
    FILLAREA 7, 37, 12, 10

    GETKEY RET$
    SETVIEW 0, 0, GETMAXX, GETMAXY
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        EXIT SUB
    END IF

    '*************************************************************************
    '* SET UP WINDOW AND SHOW COLOR FILL
    '*************************************************************************
    FILLSCREEN 0
    DRWSTRING 1, 7, 0, TITLE$, 10, 0
    A$ = "FILLCOLOR (Xseed,Yseed,OldCol,FilCol)"
    DRWSTRING 1, 7, 0, A$, 10, 16

    DRWBOX 1, 15, 5, 35, GETMAXX - 4, GETMAXY - 4
    SETVIEW 6, 36, GETMAXX - 5, GETMAXY - 5

    Colr = 1
    FOR I = 0 TO GETMAXX \ 10
        X = 50 + RND * (GETMAXX - 50)
        Y = 50 + RND * (GETMAXY - 50)
        RADX = 2 + RND * GETMAXX \ 20
        RADY = 2 + RND * GETMAXX \ 20
        DRWELLIPSE 1, Colr, X, Y, RADX, RADY
        Colr = Colr + 1
        IF Colr > 9 THEN
            Colr = 1
        END IF
    NEXT I

    FOR I = 0 TO GETMAXX \ 15
        X = 50 + RND * (GETMAXX - 50)
        Y = 50 + RND * (GETMAXY - 50)
        RADX = 2 + RND * GETMAXX \ 20
        RADY = 2 + RND * GETMAXX \ 20
        DRWELLIPSE 1, 12, X, Y, RADX, RADY
    NEXT I

    GETKEY RET$
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        SETVIEW 0, 0, GETMAXX, GETMAXY
        EXIT SUB
    END IF
     
    FILLCOLOR 7, 37, 0, 10

    SETVIEW 0, 0, GETMAXX, GETMAXY
    GETKEY RET$

    END SUB

    SUB DOPAL (RET$)
    REM $DYNAMIC
    DEFINT A-Z
 
    '*************************************************************************
    '* SET UP THE TITLE
    '*************************************************************************
    TITLE$ = "DEMO 4: Palette functions"
    PALSET ORGPAL, 0, 255

    '*************************************************************************
    '* SHOW PALETTE SET/GET
    '*************************************************************************
    FILLSCREEN 0
    SETVIEW 0, 0, GETMAXX, GETMAXY
    DRWSTRING 1, 7, 0, TITLE$, 10, 0
    A$ = "PALGET (Palette$,FirstColr,LastColr) PALSET (Palette$,FirtColr,LastColr)"
    DRWSTRING 1, 7, 0, A$, 10, 16
    Colr = 16
    X1 = 10
    X2 = GETMAXX - 9
    Y1 = 35
    Y2 = GETMAXY - 9
    I = 0
    WHILE Y1 + I < Y2 - I
        DRWBOX 1, Colr, X1 + I, Y1 + I, X2 - I, Y2 - I
        Colr = Colr + 1
        IF Colr > 255 THEN
            Colr = 16
        END IF
        I = I + 1
    WEND
    GETKEY RET$
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        FILLSCREEN 0
        PALSET PAL, 16, 255
        SETVIEW 0, 0, GETMAXX, GETMAXY
        EXIT SUB
    END IF
    PALSET PAL, 16, 255

    '*************************************************************************
    '* SHOW PALETTE AUTO FADE OUT/IN
    '*************************************************************************
    A$ = "PALIOAUTO (Palette$,FirstColr,LastColr,Speed)                           "
    DRWSTRING 1, 7, 0, A$, 10, 16
    GETKEY RET$
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        SETVIEW 0, 0, GETMAXX, GETMAXY
        EXIT SUB
    END IF
    PALIOAUTO PAL, 16, 255, -2
    PALIOAUTO PAL, 16, 255, 2

    '*************************************************************************
    '* SHOW PALETTE AUTO FADE TO
    '*************************************************************************
    A$ = "PALCHGAUTO (Palette$,NewPalette$,FirstColr,LastColr,Speed)"
    DRWSTRING 1, 7, 0, A$, 10, 16
    GETKEY RET$
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        SETVIEW 0, 0, GETMAXX, GETMAXY
        EXIT SUB
    END IF
    PALCHGAUTO PAL, PAL2, 16, 255, 2
    PALCHGAUTO PAL2, PAL, 16, 255, 2

    '*************************************************************************
    '* SHOW PALETTE ROTATE
    '*************************************************************************
    A$ = "PALROTATE (Palette$,FirstColr,LastColr,Shift)             "
    DRWSTRING 1, 7, 0, A$, 10, 16
    GETKEY RET$
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        SETVIEW 0, 0, GETMAXX, GETMAXY
        EXIT SUB
    END IF
    FOR I = 0 TO 240
        PALROTATE PAL, 16, 255, 2
        PALGET PAL, 16, 255
    NEXT I
    FOR I = 0 TO 120
        PALROTATE PAL, 16, 255, -8
        PALGET PAL, 16, 255
    NEXT I
    GETKEY RET$
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        SETVIEW 0, 0, GETMAXX, GETMAXY
        EXIT SUB
    END IF

    END SUB

    SUB DOPRIMS (RET$)
    REM $DYNAMIC
    DEFINT A-Z

    DIM P1 AS P2DType
    DIM OFF1 AS P2DType
    DIM OFF2 AS P2DType
    DIM P2 AS P2DType
 
    '*************************************************************************
    '* SET UP THE TITLE
    '*************************************************************************
    TITLE$ = "DEMO 1: Primitives"
    PALSET PAL, 0, 255
     
    '*************************************************************************
    '* DRAW SOME POINTS
    '*************************************************************************
    FILLSCREEN 0
    SETVIEW 0, 0, GETMAXX, GETMAXY
    DRWSTRING 1, 7, 0, TITLE$, 10, 0
    A$ = "DRWPOINT (Mode,Color,X1,Y1,X2,Y2)"
    DRWSTRING 1, 7, 0, A$, 10, 18
    SETVIEW 0, 32, GETMAXX, GETMAXY
    Colr = 1
    NUMOF = GETMAXX * 2
    FOR A = 0 TO NUMOF
        X1 = RND * GETMAXX
        Y1 = RND * GETMAXY
        DRWPOINT 1, Colr, X1, Y1
        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 LINES
    '*************************************************************************
    SETVIEW 0, 0, GETMAXX, GETMAXY
    FILLSCREEN 0
    DRWSTRING 1, 7, 0, TITLE$, 10, 0
    A$ = "DRWLINE (Mode,Color,X1,Y1,X2,Y2)"
    DRWSTRING 1, 7, 0, A$, 10, 18
    SETVIEW 0, 32, GETMAXX, GETMAXY
    NUMOF = GETMAXX \ 6
    FOR A = 0 TO NUMOF
        X1 = RND * GETMAXX
        Y1 = RND * GETMAXY
        X2 = RND * GETMAXX
        Y2 = RND * GETMAXY
        DRWLINE 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 ANTIALIASED LINES
    '*************************************************************************
    SETVIEW 0, 0, GETMAXX, GETMAXY
    FILLSCREEN 0
    DRWSTRING 1, 7, 0, TITLE$, 10, 0
    A$ = "DRWALINE (IntsBits,Color,X1,Y1,X2,Y2)  [antialiased lines]"
    DRWSTRING 1, 7, 0, A$, 10, 18
    SETVIEW 0, 32, GETMAXX, GETMAXY
    NUMOF = GETMAXX \ 8
    '* SET UP THE PALETTE..WE USE PCXPAL AS A TEMPORARY PALETTE
    INTSBITS = 2
    NUMLEVELS = 2 ^ INTSBITS
    PALGET PCXPAL, 0, 255
    FOR I = 0 TO NUMLEVELS - 1
        '* WE DO NOT SHADE COMPLETELY TO ZERO: COLORS RANGE FROM 63 - 28

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

        '* GREEN
        OFST = 1 + (128 + NUMLEVELS * 1 + 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$(0)