svgamod1.bas

Quick Basic DOS Compilers

'****************************************************************************
'*
'*      'SVGAQB' & 'SVGAPV' A Super VGA Graphics Librarys for use with
'*      MS QuickBASIC 4.5 and MS PDS/VBDOS
'*      Copyright 1993-1997 by Stephen L. Balkum and Daniel A. Sill
'*
'*      MS, QuickBASIC, PDS, and VBDOS are registered trademarks of
'*      Microsoft Corporation.
'*
'*    **************** UNREGISTERED SHAREWARE VERSION **********************
'*    * FOR EVALUATION ONLY. NOT FOR RESALE IN ANY FORM. SOFTWARE WRITTEN  *
'*    * USING THIS UNREGISTERED SHAREWARE GRAPHICS LIBRARY MAY NOT BY SOLD *
'*    * OR USED FOR ANY PURPOSE OTHER THAN THE EVALUATION OF THIS LIBRARY. *
'*    **********************************************************************
'*
'*    **************** NO WARRANTIES AND NO LIABILITY **********************
'*    * Stephen L. Balkum and Daniel A. Sill provide no warranties, either *
'*    * expressed or implied, of merchant ability, or fitness, for a       *
'*    * particular use or purpose of this SOFTWARE and documentation.      *
'*    * In no event shall Stephen L. Balkum or Daniel A. Sill be held      *
'*    * liable for any damages resulting from the use or misuse of the     *
'*    * SOFTWARE and documentation.                                        *
'*    **********************************************************************
'*
'*    ************** U.S. GOVERNMENT RESTRICTED RIGHTS *********************
'*    * Use, duplication, or disclosure of the SOFTWARE and documentation  *
'*    * by the U.S. Government is subject to the restrictions as set forth *
'*    * in subparagraph (c)(1)(ii) of the Rights in Technical Data and     *
'*    * Computer Software clause at DFARS 252.227-7013.                    *
'*    * Contractor/manufacturer is Stephen L. Balkum and Daniel A. Sill,   *
'*    * P.O. Box 7704, Austin, Texas 78713-7704                            *
'*    **********************************************************************
'*
'*    **********************************************************************
'*    * By using this SOFTWARE or documentation, you agree to the above    *
'*    * terms and conditions.                                              *
'*    **********************************************************************
'*
'****************************************************************************


    REM $INCLUDE: 'SVGABC.BI'
    REM $INCLUDE: 'SVGADEMO.BI'
    REM $DYNAMIC
    DEFINT A-Z

    SUB DOBLOCK (RET$)
    REM $DYNAMIC
    DEFINT A-Z
    MYPI! = ATN(1) * 4

    '*************************************************************************
    '* SET UP THE TITLE
    '*************************************************************************
    TITLE$ = "DEMO 5: Block functions and Sprites"
    PALSET PAL, 0, 255

    '*************************************************************************
    '* SHOW BLOCK GET (DRAW SOME CIRCLES AND "GET A CHUNK OF THEM")
    '*************************************************************************
    FILLSCREEN 0
    SETVIEW 0, 0, GETMAXX, GETMAXY
    DRWSTRING 1, 7, 0, TITLE$, 10, 0
    A$ = "BLKGET (X1,Y1,X2,Y2,GfxBlock)"
    DRWSTRING 1, 7, 0, A$, 10, 16
    Colr = 16
    FOR I = 0 TO GETMAXX \ 2
        DRWCIRCLE 1, Colr, GETMAXX \ 4 + I, GETMAXY \ 2, GETMAXY \ 5
        Colr = Colr + 4
        IF Colr > 255 THEN
            Colr = 16
        END IF
    NEXT I
    XINC = GETMAXX \ 20
    YINC = GETMAXY \ 20
    X1 = GETMAXX \ 2 - XINC
    Y1 = GETMAXY \ 2 - YINC
    X2 = GETMAXX \ 2 + XINC
    Y2 = GETMAXY \ 2 + YINC
    DRWBOX 1, 0, X1, Y1, X2, Y2
    BLKSIZE1 = (((X2 - X1 + 1) * (Y2 - Y1 + 1)) / 2) + 3
    REDIM GFXBLK1(0 TO BLKSIZE1) AS INTEGER
    BLKGET X1, Y1, X2, Y2, GFXBLK1(0)
    GETKEY RET$
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        FILLSCREEN 0
        EXIT SUB
    END IF
 
    '*************************************************************************
    '* SHOW BLOCK ROTATE AND SPRITE STUFF
    '*************************************************************************
    X = (X2 - X1) \ 2 + X1
    Y = (Y2 - Y1) \ 2 + Y1
    A$ = "BLKROTATE (Angle,BackFill,SourceGfxBlock,DestGfxBlock)   "
    DRWSTRING 1, 7, 0, A$, 10, 16
    A$ = "SPRITEGAP(TranSColr,X,Y,SpriteArray,BackGroundGfxBlock)"
    DRWSTRING 1, 7, 0, A$, 10, 32
    A$ = "SPRITEPUT(Mode%,TranSColr,X,Y,SpriteArray)"
    DRWSTRING 1, 7, 0, A$, 10, 48
    FILLAREA X1 + 2, Y1 + 2, 0, 0
    BLKSIZE2 = (BLKROTATESIZE(45, GFXBLK1(0)) \ 2) + 1
    REDIM GFXBLK2(0 TO BLKSIZE2) AS INTEGER
    REDIM GFXBLK3(0 TO BLKSIZE2) AS INTEGER
    BLKGET X1, Y1, X2, Y2, GFXBLK3(0)
    SETVIEW 0, 64, GETMAXX, GETMAXY
    FOR I = 0 TO 360 STEP 3
        DUMMY = BLKROTATE(I, 1, GFXBLK1(0), GFXBLK2(0))
        SPRITEPUT 1, 1, X - GFXBLK3(0) \ 2, Y - GFXBLK3(1) \ 2, GFXBLK3(0)
        SPRITEGAP 1, X - GFXBLK2(0) \ 2, Y - GFXBLK2(1) \ 2, GFXBLK2(0), GFXBLK3(0)
        SDELAY 4
    NEXT I
    SPRITEPUT 1, 1, X - GFXBLK3(0) \ 2, Y - GFXBLK3(1) \ 2, GFXBLK3(0)
    BLKPUT 1, X1, Y1, GFXBLK1(0)
    GETKEY RET$
    SETVIEW 0, 0, GETMAXX, GETMAXY
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        FILLSCREEN 0
        EXIT SUB
    END IF

    '*************************************************************************
    '* SHOW BLOCK RESIZE AND SPRITE STUFF
    '*************************************************************************
    A$ = "BLKRESIZE (NewWidth,NewHeight,SourceGfxBlock,DestGfxBlock)   "
    DRWSTRING 1, 7, 0, A$, 10, 16
    A$ = "SPRITEGAP(TranSColr,X,Y,SpriteArray,BackGroundGfxBlock)"
    DRWSTRING 1, 7, 0, A$, 10, 32
    A$ = "SPRITEPUT(Mode%,TranSColr,X,Y,SpriteArray)"
    DRWSTRING 1, 7, 0, A$, 10, 48
    SETVIEW 0, 64, GETMAXX, GETMAXY
    FILLAREA X1 + 2, Y1 + 2, 0, 0
    BLKSIZE3 = (((X2 - X1 + 1) * (Y2 - Y1 + 1)) / 2) + 3
    REDIM GFXBLK3(0 TO BLKSIZE3) AS INTEGER
    BLKGET X1, Y1, X2, Y2, GFXBLK3(0)
    BLKSIZE2 = (((GFXBLK1(0) + 1) * (GFXBLK1(1) + 1)) / 2) + 3
    REDIM GFXBLK2(BLKSIZE2) AS INTEGER
    FOR I = 0 TO XINC
        BLKRESIZE GFXBLK1(0) - I, GFXBLK1(1) - I, GFXBLK1(0), GFXBLK2(0)
        SPRITEPUT 1, 1, X - GFXBLK3(0) \ 2, Y - GFXBLK3(1) \ 2, GFXBLK3(0)
        SPRITEGAP 1, X - GFXBLK2(0) \ 2, Y - GFXBLK2(1) \ 2, GFXBLK2(0), GFXBLK3(0)
        SDELAY 5
    NEXT I
    SPRITEPUT 1, 1, X - GFXBLK3(0) \ 2, Y - GFXBLK3(1) \ 2, GFXBLK3(0)
    FOR I = XINC TO 0 STEP -1
        BLKRESIZE GFXBLK1(0) - I, GFXBLK1(1) - I, GFXBLK1(0), GFXBLK2(0)
        SPRITEPUT 1, 1, X - GFXBLK3(0) \ 2, Y - GFXBLK3(1) \ 2, GFXBLK3(0)
        SPRITEGAP 1, X - GFXBLK2(0) \ 2, Y - GFXBLK2(1) \ 2, GFXBLK2(0), GFXBLK3(0)
        SDELAY 5
    NEXT I
    SPRITEPUT 1, 1, X - GFXBLK1(0) \ 2, Y - GFXBLK1(1) \ 2, GFXBLK1(0)
    GETKEY RET$
    SETVIEW 0, 0, GETMAXX, GETMAXY
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        FILLSCREEN 0
        EXIT SUB
    END IF

    '*************************************************************************
    '* SHOW BLOCK PUT (PUT THE "CHUNKS" RANDOMLY AROUND THE SCREEN)
    '*************************************************************************
    SETVIEW 0, 31, GETMAXX, 64
    FILLVIEW 0
    A$ = "BLKPUT (Mode,X,Y,GfxBlock)   "
    DRWSTRING 1, 7, 0, A$, 10, 16
    XINC = GETMAXX \ 10
    YINC = GETMAXY \ 10
    SETVIEW 0, 32, GETMAXX, GETMAXY
    FOR I = 0 TO GETMAXX \ 2
        X = (GETMAXX + XINC) * RND - XINC
        Y = (GETMAXY + YINC) * RND - YINC
        BLKPUT 1, X, Y, GFXBLK1(0)
    NEXT I
    GETKEY RET$
    SETVIEW 0, 0, GETMAXX, GETMAXY
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        FILLSCREEN 0
        EXIT SUB
    END IF

    END SUB

    SUB DOCLIP (RET$)
    REM $DYNAMIC
    DEFINT A-Z
 
    '*************************************************************************
    '* SET UP AND SHOW THE TITLE
    '*************************************************************************
    TITLE$ = "DEMO 2: Clipping capability"
    PALSET PAL2, 0, 255

    '*************************************************************************
    '* SET UP THE WINDOWS
    '*************************************************************************
    FILLSCREEN 0
    SETVIEW 0, 0, GETMAXX, GETMAXY
    DRWSTRING 1, 7, 0, TITLE$, 10, 0
    A$ = "All primitives automatically clip"
    DRWSTRING 1, 7, 0, A$, 10, 16

    WDTH = (GETMAXX + 1) / 2.25
    SPCINGX = ((GETMAXX + 1) - WDTH * 2) / 3
    HGTH = (GETMAXY + 1 - 35) / 2.25
    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

    Colr = 1

    '*************************************************************************
    '* SHOW THE CLIPPING
    '*************************************************************************
    FOR I = 0 TO GETMAXX \ 6
        FOR J = 1 TO 4
            SELECT CASE J
                CASE IS = 1
                    SETVIEW B1X1, B1Y1, B1X2, B1Y2
                    FOR K = 0 TO 4
                        X = B1X1 + RND * XINC - XSUB
                        Y = B1Y1 + RND * XINC - XSUB
                        DRWPOINT 1, Colr, X, Y
                        Colr = Colr + 1
                        IF Colr > 15 THEN
                            Colr = 1
                        END IF
                    NEXT K
                CASE IS = 2
                    SETVIEW B2X1, B2Y1, B2X2, B2Y2
                    X1 = B2X1 + RND * XINC - XSUB
                    Y1 = B2Y1 + RND * XINC - XSUB
                    X2 = B2X1 + RND * XINC - XSUB
                    Y2 = B2Y1 + RND * XINC - XSUB
                    DRWLINE 1, Colr, X1, Y1, X2, Y2
                    Colr = Colr + 1
                    IF Colr > 15 THEN
                        Colr = 1
                    END IF
                CASE IS = 3
                    SETVIEW B3X1, B3Y1, B3X2, B3Y2
                    X = B3X1 + RND * XINC - XSUB
                    Y = B3Y1 + RND * XINC - XSUB
                    RAD = RND * WDTH \ 2
                    DRWCIRCLE 1, Colr, X, Y, RAD
                    Colr = Colr + 1
                    IF Colr > 15 THEN
                        Colr = 1
                    END IF
                CASE IS = 4
                    SETVIEW B4X1, B4Y1, B4X2, B4Y2
                    X = B4X1 + RND * XINC - XSUB
                    Y = B4Y1 + RND * XINC - XSUB
                    RADX = RND * WDTH \ 2
                    RADY = RND * WDTH \ 2
                    DRWELLIPSE 1, Colr, X, Y, RADX, RADY
                    Colr = Colr + 1
                    IF Colr > 15 THEN
                        Colr = 1
                    END IF
            END SELECT
        NEXT J
    NEXT I
    SETVIEW 0, 0, GETMAXX, GETMAXY
    GETKEY RET$
    IF (RET$ = "S") OR (RET$ = "Q") THEN
        EXIT SUB
    END IF

    END SUB

    SUB DOFILL (RET$)
    REM $DYNAMIC
    DEFINT A-Z
 
    '*************************************************************************
    '* SET UP THE TITLE
    '*************************************************************************
    TITLE$ = "DEMO 3: Filling functions"
    PALSET PAL, 0, 255

    '*************************************************************************
    '* SHOW SCREEN FILL
    '*************************************************************************
    FILLSCREEN 10
    SETVIEW 0, 0, GETMAXX, GETMAXY
    DRWSTRING 1, 7, 0, TITLE$, 10, 0
    A$ = "FILLSCREEN (Color)"
    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

    '*************************************************************************
    '* SET UP WINDOWS AND SHOW VIEWPORT FILL
    '*************************************************************************
    FILLSCREEN 0
    DRWSTRING 1, 7, 0, TITLE$, 10, 0
    A$ = "FILLVIEW (Color)"
    DRWSTRING 1, 7, 0, A$, 10, 16

    WDTH = (GETMAXX + 1) / 2.25
    SPCINGX = ((GETMAXX + 1) - WDTH * 2) / 3
    HGTH = (GETMAXY + 1 - 35) / 2.25