📄 svgamod2.bas
字号:
'****************************************************************************
'*
'* '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 DO2D (RET$)
DEFINT A-Z
REM $DYNAMIC
DIM POINTARRY(0 TO 8) AS P2DType
'*************************************************************************
'* SET UP THE TITLE
'*************************************************************************
TITLE$ = "DEMO 11: 2D functions"
PALSET PAL, 0, 255
'*************************************************************************
'* SET UP THE 'STAR' PATTERN OF POINTS
'*************************************************************************
SETVIEW 0, 0, GETMAXX, GETMAXY
CNTX = GETMAXX \ 2
CNTY = ((GETMAXY - 32) \ 2) + 32
SPCNG = GETMAXX \ 30
POINTARRY(0).X = 0
POINTARRY(0).Y = -SPCNG * 6
POINTARRY(1).X = SPCNG * 2
POINTARRY(1).Y = -SPCNG * 2
POINTARRY(2).X = SPCNG * 6
POINTARRY(2).Y = 0
POINTARRY(3).X = SPCNG * 2
POINTARRY(3).Y = SPCNG * 2
POINTARRY(4).X = 0
POINTARRY(4).Y = SPCNG * 6
POINTARRY(5).X = -SPCNG * 2
POINTARRY(5).Y = SPCNG * 2
POINTARRY(6).X = -SPCNG * 6
POINTARRY(6).Y = 0
POINTARRY(7).X = -SPCNG * 2
POINTARRY(7).Y = -SPCNG * 2
POINTARRY(8).X = 0
POINTARRY(8).Y = -SPCNG * 6
'*************************************************************************
'* SHOW D2TRANSLATE
'*************************************************************************
FILLSCREEN 0
DRWSTRING 1, 7, 0, TITLE$, 10, 0
A$ = "D2TRANSLATE (Points,XTrans,YTrans,InAry,OutAry)"
DRWSTRING 1, 7, 0, A$, 10, 16
SETVIEW 0, 32, GETMAXX, GETMAXY
D2TRANSLATE 9, CNTX, CNTY, POINTARRY(0).X, PLOTARRY(0).X
SHOWSTAR
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
FILLSCREEN 0
SETVIEW 0, 0, GETMAXX, GETMAXY
EXIT SUB
END IF
XTRANS = 0
YTRANS = 0
FOR J = 0 TO SPCNG * 2
XTRANS = XTRANS + 2
YTRANS = YTRANS + 2
D2TRANSLATE 9, CNTX + XTRANS, CNTY + YTRANS, POINTARRY(0).X, PLOTARRY(0).X
SHOWSTAR
SDELAY 2
NEXT J
FOR J = 0 TO SPCNG * 2
XTRANS = XTRANS - 2
YTRANS = YTRANS - 2
D2TRANSLATE 9, CNTX + XTRANS, CNTY + YTRANS, POINTARRY(0).X, PLOTARRY(0).X
SHOWSTAR
SDELAY 2
NEXT J
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
FILLSCREEN 0
SETVIEW 0, 0, GETMAXX, GETMAXY
EXIT SUB
END IF
'*************************************************************************
'* SHOW D2SCALE
'*************************************************************************
SETVIEW 0, 0, GETMAXX, 31
FILLVIEW 0
SETVIEW 0, 0, GETMAXX, GETMAXY
DRWSTRING 1, 7, 0, TITLE$, 10, 0
A$ = "D2SCALE (Points,XScale,YScale,InAry,OutAry)"
DRWSTRING 1, 7, 0, A$, 10, 16
SETVIEW 0, 32, GETMAXX, GETMAXY
D2TRANSLATE 9, CNTX, CNTY, POINTARRY(0).X, PLOTARRY(0).X
SHOWSTAR
FOR J = 256 TO 380 STEP 4
D2SCALE 9, J, J, POINTARRY(0).X, PLOTARRY(0).X
D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
SHOWSTAR
SDELAY 2
NEXT J
X = J
FOR J = X TO 256 STEP -4
D2SCALE 9, J, J, POINTARRY(0).X, PLOTARRY(0).X
D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
SHOWSTAR
SDELAY 2
NEXT J
X = J
FOR J = X TO 128 STEP -4
D2SCALE 9, J, J, POINTARRY(0).X, PLOTARRY(0).X
D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
SHOWSTAR
SDELAY 2
NEXT J
X = J
FOR J = X TO 256 STEP 4
D2SCALE 9, J, J, POINTARRY(0).X, PLOTARRY(0).X
D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
SHOWSTAR
SDELAY 2
NEXT J
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
FILLSCREEN 0
SETVIEW 0, 0, GETMAXX, GETMAXY
EXIT SUB
END IF
'*************************************************************************
'* SHOW D2ROTATE (ABOUT THE CENTER OF THE OBJECT)
'*************************************************************************
SETVIEW 0, 0, GETMAXX, 31
FILLVIEW 0
SETVIEW 0, 0, GETMAXX, GETMAXY
DRWSTRING 1, 7, 0, TITLE$, 10, 0
A$ = "D2ROTATE (Points,XOrigin,YOrigin,Angle,InAry,OutAry)"
DRWSTRING 1, 7, 0, A$, 10, 16
A$ = "Lets do it about the center of the object."
DRWSTRING 1, 7, 0, A$, 10, 32
SETVIEW 0, 32, GETMAXX, GETMAXY
D2TRANSLATE 9, CNTX, CNTY, POINTARRY(0).X, PLOTARRY(0).X
SHOWSTAR
FOR J = 0 TO 180
D2ROTATE 9, 0, 0, J, POINTARRY(0).X, PLOTARRY(0).X
D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
SHOWSTAR
SDELAY 2
NEXT J
FOR J = 180 TO 0 STEP -2
D2ROTATE 9, 0, 0, J, POINTARRY(0).X, PLOTARRY(0).X
D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
SHOWSTAR
SDELAY 2
NEXT J
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
FILLSCREEN 0
SETVIEW 0, 0, GETMAXX, GETMAXY
EXIT SUB
END IF
'*************************************************************************
'* SHOW D2ROTATE (ABOUT AN ARBITRARY POINT)
'*************************************************************************
SETVIEW 0, 0, GETMAXX, 48
FILLVIEW 0
SETVIEW 0, 0, GETMAXX, GETMAXY
DRWSTRING 1, 7, 0, TITLE$, 10, 0
A$ = "D2ROTATE (Points,XOrigin,YOrigin,Angle,InAry,OutAry)"
DRWSTRING 1, 7, 0, A$, 10, 16
A$ = "Lets do it about an arbitrary point."
DRWSTRING 1, 7, 0, A$, 10, 32
SETVIEW 0, 32, GETMAXX, GETMAXY
D2TRANSLATE 9, CNTX, CNTY, POINTARRY(0).X, PLOTARRY(0).X
SHOWSTAR
FOR J = 0 TO 360 STEP 2
D2ROTATE 9, 0, SPCNG * 6, J, POINTARRY(0).X, PLOTARRY(0).X
D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
SHOWSTAR
SDELAY 2
NEXT J
SETVIEW 0, 0, GETMAXX, GETMAXY
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
FILLSCREEN 0
EXIT SUB
END IF
END SUB
SUB DO3D (RET$)
DEFINT A-Z
REM $DYNAMIC
'*************************************************************************
'* SET UP THE TITLE
'*************************************************************************
TITLE$ = "DEMO 12: 3D functions"
PALSET PAL, 0, 255
'*************************************************************************
'* SET UP THE 'HOUSE' PATTERN OF POINTS
'*************************************************************************
SETVIEW 0, 0, GETMAXX, GETMAXY
CNTX = GETMAXX \ 2
CNTY = ((GETMAXY - 32) \ 2) + 32
CNTZ = 0
SPCNG = GETMAXX \ 6
POINTARRY3D(0).X = -SPCNG
POINTARRY3D(0).Y = -SPCNG * 2
POINTARRY3D(0).Z = 0
POINTARRY3D(1).X = SPCNG
POINTARRY3D(1).Y = -SPCNG * 2
POINTARRY3D(1).Z = 0
POINTARRY3D(2).X = SPCNG
POINTARRY3D(2).Y = -SPCNG * 2
POINTARRY3D(2).Z = SPCNG * 2
POINTARRY3D(3).X = -SPCNG
POINTARRY3D(3).Y = -SPCNG * 2
POINTARRY3D(3).Z = SPCNG * 2
POINTARRY3D(4).X = -SPCNG
POINTARRY3D(4).Y = SPCNG * 2
POINTARRY3D(4).Z = 0
POINTARRY3D(5).X = SPCNG
POINTARRY3D(5).Y = SPCNG * 2
POINTARRY3D(5).Z = 0
POINTARRY3D(6).X = SPCNG
POINTARRY3D(6).Y = SPCNG * 2
POINTARRY3D(6).Z = SPCNG * 2
POINTARRY3D(7).X = -SPCNG
POINTARRY3D(7).Y = SPCNG * 2
POINTARRY3D(7).Z = SPCNG * 2
POINTARRY3D(8).X = 0
POINTARRY3D(8).Y = -SPCNG * 2
POINTARRY3D(8).Z = SPCNG * 3
POINTARRY3D(9).X = 0
POINTARRY3D(9).Y = SPCNG * 2
POINTARRY3D(9).Z = SPCNG * 3
POINTARRY3D(10).X = 0
POINTARRY3D(10).Z = 0
POINTARRY3D(10).Y = 0
POINTARRY3D(11).X = SPCNG * 4
POINTARRY3D(11).Z = 0
POINTARRY3D(11).Y = 0
POINTARRY3D(12).X = 0
POINTARRY3D(12).Z = 0
POINTARRY3D(12).Y = SPCNG * 4
POINTARRY3D(13).X = 0
POINTARRY3D(13).Z = SPCNG * 4
POINTARRY3D(13).Y = 0
'*************************************************************************
'* SHOW D3PROJECT
'*************************************************************************
PI! = 4 * ATN(1) / 180
FILLSCREEN 0
DRWSTRING 1, 7, 0, TITLE$, 10, 0
A$ = "D3PROJECT (Points,ProjParams,InAry,OutAry)"
DRWSTRING 1, 7, 0, A$, 10, 16
SETVIEW 0, 32, GETMAXX, GETMAXY
HEIGHT = GETMAXY * 8
Radius = GETMAXX * 30
J = 110
PROJ.EYEX = FIX(-Radius * COS(J * PI!))
PROJ.EYEY = FIX(-Radius * SIN(J * PI!))
PROJ.EYEZ = HEIGHT
PROJ.SCRD = ((Radius ^ 2 + HEIGHT ^ 2) ^ .5) \ 2
PROJ.THETA = J
PROJ.PHI = CINT(ATN(HEIGHT / -Radius) / PI!)
BYTECOPY POINTARRY3D(0).X, PLAYARRY(0).X, 84
R = D3PROJECT(14, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
BYTECOPY PLOTARRY(0).X, OPLOTARRY(0).X, 56
SHOWHOUSE
GETKEY RET$
IF (RET$ = "S") OR (RET$ = "Q") THEN
FILLSCREEN 0
SETVIEW 0, 0, GETMAXX, GETMAXY
EXIT SUB
END IF
FOR J = 112 TO 470 STEP 3
PROJ.EYEX = FIX(-Radius * COS(J * PI!))
PROJ.EYEY = FIX(-Radius * SIN(J * PI!))
PROJ.THETA = J
R = D3PROJECT(14, 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
'*************************************************************************
'* SHOW D3TRANSLATE
'*************************************************************************
SETVIEW 0, 0, GETMAXX, 31
FILLVIEW 0
DRWSTRING 1, 7, 0, TITLE$, 10, 0
A$ = "D3TRANSLATE (Points,XTrans,YTrans,ZTrans,InAry,OutAry)"
DRWSTRING 1, 7, 0, A$, 10, 16
SETVIEW 0, 32, GETMAXX, GETMAXY
FOR J = 2 TO 300 STEP 6
D3TRANSLATE 10, J, J, 0, POINTARRY3D(0).X, PLAYARRY(0).X
R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
SHOWHOUSE
SDELAY 2
NEXT J
X = J
FOR J = X TO 2 STEP -6
D3TRANSLATE 10, J, J, 0, 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
'*************************************************************************
'* SHOW D3SCALE
'*************************************************************************
SETVIEW 0, 0, GETMAXX, 31
FILLVIEW 0
DRWSTRING 1, 7, 0, TITLE$, 10, 0
A$ = "D3SCALE (Points,XScale,YScale,ZScale,InAry,OutAry)"
DRWSTRING 1, 7, 0, A$, 10, 16
SETVIEW 0, 32, GETMAXX, GETMAXY
FOR J = 256 TO 380 STEP 4
D3SCALE 10, J, J, J, POINTARRY3D(0).X, PLAYARRY(0).X
R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
SHOWHOUSE
SDELAY 2
NEXT J
X = J
FOR J = X TO 256 STEP -4
D3SCALE 10, J, J, J, POINTARRY3D(0).X, PLAYARRY(0).X
R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
SHOWHOUSE
SDELAY 2
NEXT J
X = J
FOR J = X TO 128 STEP -4
D3SCALE 10, J, J, J, POINTARRY3D(0).X, PLAYARRY(0).X
R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
SHOWHOUSE
SDELAY 2
NEXT J
X = J
FOR J = X TO 256 STEP 4
D3SCALE 10, J, 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
'*************************************************************************
'* SHOW D2ROTATE (ABOUT THE ORIGIN)
'*************************************************************************
SETVIEW 0, 0, GETMAXX, 31
FILLVIEW 0
DRWSTRING 1, 7, 0, TITLE$, 10, 0
A$ = "D3ROTATE (Points,XOrigin,YOrigin,ZOrigin,ZAngle,YAngle,XAngle,InAry,OutAry) "
DRWSTRING 1, 7, 0, A$, 10, 16
A$ = "Lets do it about the origin."
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -