+++ /dev/null
-'File: TEST6A.BAS\r
-'Descp.: A Mode "X" demonstration for Quickbasic 4.5\r
-'Author: Matt Pritchard\r
-'Date: 14 April, 1993\r
-'\r
-DECLARE SUB DEMO.RES (Mode%, Xmax%, Ymax%)\r
-DECLARE SUB ERROR.OUT (Message$)\r
-DECLARE FUNCTION GET.KEY% ()\r
-DECLARE SUB LOAD.SHAPES ()\r
-DECLARE SUB PAGE.DEMO ()\r
-DECLARE SUB PRINT.TEXT (Text$, Xpos%, Ypos%, ColorF%, ColorB%)\r
-DECLARE SUB TPRINT.TEXT (Text$, Xpos%, Ypos%, ColorF%)\r
-DEFINT A-Z\r
-\r
-\r
-TYPE ShapeType\r
- ImgData AS STRING * 512\r
- xWidth AS INTEGER\r
- yWidth AS INTEGER\r
-END TYPE\r
-\r
-TYPE Sprite\r
- Xpos AS INTEGER\r
- Ypos AS INTEGER\r
- XDir AS INTEGER\r
- YDir AS INTEGER\r
- Shape AS INTEGER\r
-END TYPE\r
-\r
-\r
-CONST MaxShapes = 32\r
-\r
- REM $INCLUDE: 'UTILS.BI'\r
- REM $INCLUDE: 'MODEX.BI'\r
-\r
-DIM SHARED Img(32) AS ShapeType\r
-COMMON SHARED Img() AS ShapeType\r
-\r
-\r
- CALL INIT.RANDOM\r
-\r
- CALL LOAD.SHAPES\r
-\r
- CALL DEMO.RES(Mode320x200, 320, 200)\r
- CALL DEMO.RES(Mode320x400, 320, 400)\r
-\r
- CALL DEMO.RES(Mode360x200, 360, 200)\r
- CALL DEMO.RES(Mode360x400, 360, 400)\r
-\r
- CALL DEMO.RES(Mode320x240, 320, 240)\r
- CALL DEMO.RES(Mode320x480, 320, 480)\r
-\r
- CALL DEMO.RES(Mode360x240, 360, 240)\r
- CALL DEMO.RES(Mode360x480, 360, 480)\r
-\r
- CALL PAGE.DEMO\r
-\r
- SET.VIDEO.MODE 3\r
- DOS.PRINT "THIS MODE X DEMO IS FINISHED"\r
- END\r
-\r
-SUB DEMO.RES (Mode, Xmax, Ymax)\r
-\r
- IF SET.MODEX%(Mode) = 0 THEN\r
- ERROR.OUT "Unable to SET_MODEX" + STR$(Mode)\r
- END IF\r
-\r
- XCenter = Xmax \ 2\r
- \r
- X1 = 10\r
- Y1 = 10\r
- X2 = Xmax - 1\r
- Y2 = Ymax - 1\r
-\r
- FOR Z = 0 TO 3\r
- Colr = 31 - Z * 2\r
- DRAW.LINE X1 + Z, Y1 + Z, X2 - Z, Y1 + Z, Colr\r
- DRAW.LINE X1 + Z, Y1 + Z, X1 + Z, Y2 - Z, Colr\r
- DRAW.LINE X1 + Z, Y2 - Z, X2 - Z, Y2 - Z, Colr\r
- DRAW.LINE X2 - Z, Y1 + Z, X2 - Z, Y2 - Z, Colr\r
- NEXT Z\r
-\r
- XChars = Xmax \ 10\r
- YChars = Ymax \ 10\r
-\r
- FOR X = 0 TO XChars - 1\r
- TGPRINTC 48 + ((X + 1) MOD 10), X * 10 + 1, 1, 9 + ((X \ 8) MOD 7)\r
- DRAW.LINE X * 10 + 9, 0, X * 10 + 9, 3, 15\r
- NEXT X\r
-\r
- FOR Y = 0 TO YChars - 1\r
- TGPRINTC 48 + ((Y + 1) MOD 10), 1, Y * 10 + 1, 9 + ((Y \ 10) MOD 7)\r
- DRAW.LINE 0, Y * 10 + 9, 3, Y * 10 + 9, 15\r
- NEXT Y\r
-\r
- ' Draw Lines\r
-\r
- FOR X = 0 TO 63\r
- N = 15 + X * .75\r
- SET.DAC.REGISTER 64 + X, N, N, N\r
- SET.DAC.REGISTER 128 + X, 0, N, N\r
-\r
- DRAW.LINE 103 - X, 60, 40 + X, 123, 64 + X\r
- DRAW.LINE 40, 60 + X, 103, 123 - X, 128 + X\r
-\r
- NEXT X\r
- TPRINT.TEXT "LINE TEST", 37, 130, c.BLUE\r
-\r
- Y = 60: Gap = 0\r
- FOR X = 0 TO 9\r
- FILL.BLOCK 120, Y, 120 + X, Y + Gap, 64 + X\r
- FILL.BLOCK 140 - (15 - X), Y, 150 + X, Y + Gap, 230 + X\r
- FILL.BLOCK 170 - (15 - X), Y, 170, Y + Gap, 128 + X\r
- Y = Y + Gap + 2\r
- Gap = Gap + 1\r
- NEXT X\r
- TPRINT.TEXT "FILL TEST", 110, 46, c.GREEN\r
-\r
-\r
- FOR X = 190 TO 250 STEP 2\r
- FOR Y = 60 TO 122 STEP 2\r
- SET.POINT X, Y, X + Y + X + Y\r
- NEXT Y\r
- NEXT X\r
-\r
- TPRINT.TEXT "PIXEL TEST", 182, 130, c.RED\r
-\r
- FOR X = 190 TO 250 STEP 2\r
- FOR Y = 60 TO 122 STEP 2\r
- IF READ.POINT(X, Y) <> ((X + Y + X + Y) AND 255) THEN\r
- ERROR.OUT "READ.PIXEL Failure"\r
- END IF\r
- NEXT Y\r
- NEXT X\r
-\r
-\r
-\r
- Msg$ = " This is a MODE X demo "\r
- PRINT.TEXT Msg$, XCenter - (LEN(Msg$) * 4), 20, c.bRED, c.BLUE\r
- Msg$ = "Screen Resolution is by "\r
- Xp = XCenter - (LEN(Msg$) * 4)\r
- PRINT.TEXT Msg$, Xp, 30, c.bGREEN, c.BLACK\r
-\r
- PRINT.TEXT LTRIM$(STR$(Xmax)), Xp + 8 * 21, 30, c.bPURPLE, c.BLACK\r
- PRINT.TEXT LTRIM$(STR$(Ymax)), Xp + 8 * 28, 30, c.bWHITE, c.BLACK\r
-\r
- FOR X = 0 TO 15\r
- SET.DAC.REGISTER 230 + X, 63 - X * 4, 0, 15 + X * 3\r
- DRAW.LINE 30 + X, Ymax - 6 - X, Xmax - 20 - X, Ymax - 6 - X, 230 + X\r
- NEXT X\r
- TPRINT.TEXT "Press <ANY KEY> to Continue", XCenter - (26 * 4), Ymax - 18, c.YELLOW\r
-\r
- X = GET.KEY%\r
- IF X = KyESC THEN ERROR.OUT "ABORT"\r
-\r
-END SUB\r
-\r
-SUB ERROR.OUT (Message$)\r
-\r
- SET.VIDEO.MODE 3\r
- DOS.PRINT Message$\r
- END\r
-\r
-END SUB\r
-\r
-FUNCTION GET.KEY%\r
-\r
- DO\r
- X = SCAN.KEYBOARD\r
- LOOP UNTIL X\r
-\r
- GET.KEY% = X\r
-\r
-END FUNCTION\r
-\r
-SUB LOAD.SHAPES\r
-\r
-DIM Grid(1 TO 32, 1 TO 32)\r
-\r
- FOR Shape = 0 TO MaxShapes - 1\r
-\r
- FOR Y = 1 TO 32\r
- FOR X = 1 TO 32\r
- Grid(X, Y) = 0\r
- NEXT X\r
- NEXT Y\r
-\r
- Style = RANDOM.INT(6)\r
- Colour = 1 + RANDOM.INT(15)\r
- \r
- SELECT CASE Style\r
-\r
- CASE 0: ' Solid Box\r
-\r
- DO\r
- xWidth = 3 + RANDOM.INT(30)\r
- yWidth = 3 + RANDOM.INT(30)\r
- LOOP UNTIL ((xWidth * yWidth) <= 512)\r
-\r
- FOR Y = 1 TO yWidth\r
- FOR X = 1 TO xWidth\r
- Grid(X, Y) = Colour\r
- NEXT X\r
- NEXT Y\r
-\r
- CASE 1: ' Hollow Box\r
-\r
- DO\r
- xWidth = 5 + RANDOM.INT(28)\r
- yWidth = 5 + RANDOM.INT(28)\r
- LOOP UNTIL ((xWidth * yWidth) <= 512)\r
-\r
- FOR Y = 1 TO yWidth\r
- FOR X = 1 TO xWidth\r
- Grid(X, Y) = Colour\r
- NEXT X\r
- NEXT Y\r
-\r
- HollowX = 1 + RANDOM.INT(xWidth \ 2 - 1)\r
- HollowY = 1 + RANDOM.INT(yWidth \ 2 - 1)\r
-\r
- FOR Y = HollowY + 1 TO yWidth - HollowY\r
- FOR X = HollowX + 1 TO xWidth - HollowX\r
- Grid(X, Y) = nil\r
- NEXT X\r
- NEXT Y\r
-\r
- CASE 2: ' Solid Diamond\r
-\r
- xWidth = 3 + 2 * RANDOM.INT(10)\r
- yWidth = xWidth\r
- Centre = xWidth \ 2\r
-\r
- FOR Y = 0 TO Centre\r
- FOR X = 0 TO Y\r
- Grid(Centre - X + 1, Y + 1) = Colour\r
- Grid(Centre + X + 1, Y + 1) = Colour\r
- Grid(Centre - X + 1, yWidth - Y) = Colour\r
- Grid(Centre + X + 1, yWidth - Y) = Colour\r
- NEXT X\r
- NEXT Y\r
-\r
-\r
- CASE 3: ' Hollow Diamond\r
-\r
-\r
- xWidth = 3 + 2 * RANDOM.INT(10)\r
- yWidth = xWidth\r
- Centre = xWidth \ 2\r
- sWidth = RANDOM.INT(Centre)\r
-\r
- FOR Y = 0 TO Centre\r
- FOR X = 0 TO Y\r
- IF X + (Centre - Y) >= sWidth THEN\r
- Grid(Centre - X + 1, Y + 1) = Colour\r
- Grid(Centre + X + 1, Y + 1) = Colour\r
- Grid(Centre - X + 1, yWidth - Y) = Colour\r
- Grid(Centre + X + 1, yWidth - Y) = Colour\r
- END IF\r
- NEXT X\r
- NEXT Y\r
-\r
- CASE 4: ' Ball\r
-\r
- xWidth = 7 + 2 * RANDOM.INT(8)\r
- yWidth = xWidth\r
- Centre = 1 + xWidth \ 2\r
-\r
- FOR Y = 1 TO yWidth\r
- FOR X = 1 TO xWidth\r
- D = SQR(((Centre - X) * (Centre - X)) + ((Centre - Y) * (Centre - Y)))\r
- IF D < Centre THEN Grid(X, Y) = 150 + Colour * 2 + D * 3\r
- NEXT X\r
- NEXT Y\r
-\r
- CASE 5: ' Ball\r
-\r
-\r
- xWidth = 7 + 2 * RANDOM.INT(8)\r
- yWidth = xWidth\r
- Centre = 1 + xWidth \ 2\r
- sWidth = RANDOM.INT(xWidth)\r
-\r
- FOR Y = 1 TO yWidth\r
- FOR X = 1 TO xWidth\r
- D = SQR(((Centre - X) * (Centre - X)) + ((Centre - Y) * (Centre - Y)))\r
- IF D < Centre AND D >= sWidth THEN Grid(X, Y) = 150 + Colour * 2 + D * 3\r
- NEXT X\r
- NEXT Y\r
-\r
- END SELECT\r
-\r
- Img(Shape).xWidth = xWidth\r
- Img(Shape).yWidth = yWidth\r
-\r
- A$ = STRING$(xWidth * yWidth, nil)\r
-\r
- c = 1\r
- FOR Y = 1 TO yWidth\r
- FOR X = 1 TO xWidth\r
- MID$(A$, c, 1) = CHR$(Grid(X, Y))\r
- c = c + 1\r
- NEXT X\r
- NEXT Y\r
-\r
- Img(Shape).ImgData = A$\r
- \r
-\r
- NEXT Shape\r
-\r
-END SUB\r
-\r
-SUB PAGE.DEMO\r
-\r
-CONST MaxSprites = 64\r
-\r
-DIM Obj(MaxSprites) AS Sprite\r
-DIM LastX(MaxSprites, 1), LastY(MaxSprites, 1)\r
-DIM LastObjects(1)\r
-\r
- ScreenX = 360: ScreenY = 240\r
-\r
- IF SET.VGA.MODEX%(Mode320x200, ScreenX, ScreenY, 3) = 0 THEN\r
- ERROR.OUT "Unable to SET_VGA_MODEX" + STR$(Mode)\r
- END IF\r
-\r
- SET.ACTIVE.PAGE 0\r
-\r
- CLEAR.VGA.SCREEN c.BLACK\r
- \r
- PRINT.TEXT "This is a Test of the Following Functions:", 10, 9, c.bWHITE, c.BLACK\r
-\r
- DRAW.LINE 10, 18, 350, 18, c.YELLOW\r
- PRINT.TEXT "SET_ACTIVE_PAGE", 10, 20, c.bBLUE, c.BLACK\r
- PRINT.TEXT "SET_DISPLAY_PAGE", 10, 30, c.GREEN, c.BLACK\r
- PRINT.TEXT "SET_DAC_REGISTER", 10, 40, c.RED, c.BLACK\r
- PRINT.TEXT "CLEAR_VGA_SCREEN", 10, 50, c.CYAN, c.BLACK\r
-\r
- PRINT.TEXT "TDRAW_BITMAP", 10, 60, c.PURPLE, c.BLACK\r
- PRINT.TEXT "COPY_PAGE", 10, 70, c.GREEN, c.BLACK\r
- PRINT.TEXT "COPY_BITMAP", 10, 80, c.CYAN, c.BLACK\r
-\r
- PRINT.TEXT "GPRINTC", 10, 90, c.BLUE, c.BLACK\r
- PRINT.TEXT "TGPRINTC", 10, 100, c.GREEN, c.BLACK\r
- PRINT.TEXT "SET_WINDOW", 10, 110, c.RED, c.BLACK\r
-\r
- PRINT.TEXT "VIRTUAL SCREEN SIZES", 190, 20, c.bBLUE, c.BLACK\r
- PRINT.TEXT " SMOOTH SCROLLING", 190, 30, c.GREEN, c.BLACK\r
- PRINT.TEXT " SPRITE ANIMATION", 190, 40, c.CYAN, c.BLACK\r
- PRINT.TEXT " PAGE FLIPPING", 190, 50, c.RED, c.BLACK\r
- PRINT.TEXT " COLOR CYCLING", 190, 60, c.PURPLE, c.BLACK\r
-\r
-\r
- FOR X = 0 TO 60\r
- SET.DAC.REGISTER 50 + X, 3 + X, 0, 60 - X\r
- SET.DAC.REGISTER 150 + X, 3 + X, 0, 60 - X\r
- NEXT X\r
-\r
- c = 0: DC = 1\r
- FOR X = 0 TO ScreenX \ 2\r
- DRAW.LINE ScreenX \ 2 - 1, ScreenY \ 4, X, ScreenY - 1, c + 50\r
- DRAW.LINE ScreenX \ 2, ScreenY \ 4, ScreenX - X - 1, ScreenY - 1, c + 50\r
- c = c + DC\r
- IF c = 0 OR c = 60 THEN DC = -DC\r
- NEXT X\r
- \r
- TPRINT.TEXT "Press <ANY KEY> to Continue", 72, 190, c.bWHITE\r
- TPRINT.TEXT "< > = Faster < > = Slower", 72, 204, c.bGREEN\r
- TPRINT.TEXT "< > = Fewer Shapes < > = More Shapes", 32, 218, c.bCYAN\r
-\r
- TGPRINTC 43, 80, 204, c.YELLOW\r
- TGPRINTC 45, 200, 204, c.YELLOW\r
-\r
- TGPRINTC 25, 40, 218, c.YELLOW\r
- TGPRINTC 24, 200, 218, c.YELLOW\r
-\r
- COPY.PAGE 0, 1\r
- COPY.PAGE 0, 2\r
-\r
- FOR X = 1 TO MaxSprites\r
- DO\r
- Obj(X).XDir = RANDOM.INT(7) - 3\r
- Obj(X).YDir = RANDOM.INT(7) - 3\r
- LOOP WHILE (Obj(X).XDir = 0 AND Obj(X).YDir = 0)\r
-\r
- Obj(X).Shape = X MOD MaxShapes\r
-\r
- SpriteX = Img(Obj(X).Shape).xWidth\r
- SpriteY = Img(Obj(X).Shape).yWidth\r
-\r
- Obj(X).Xpos = 1 + RANDOM.INT(ScreenX - SpriteX - 2)\r
- Obj(X).Ypos = 1 + RANDOM.INT(ScreenY - SpriteY - 2)\r
-\r
- LastX(X, 0) = Obj(X).Xpos\r
- LastX(X, 1) = Obj(X).Xpos\r
- LastY(X, 0) = Obj(X).Ypos\r
- LastY(X, 1) = Obj(X).Ypos\r
- NEXT X\r
-\r
- CurrentPage = 0\r
-\r
- 'View Shift...\r
-\r
- ViewX = 0\r
- ViewY = 0\r
- ViewMax = 3\r
- ViewCnt = 0\r
- ViewXD = 1\r
- ViewYD = 1\r
-\r
- SetColor = 3: SDir = 1\r
- PrevColor = 0: PDir = 1\r
-\r
- VisObjects = MaxSprites \ 2\r
- LastObjects(0) = 0\r
- LastObjects(1) = 0\r
-\r
-DRAW.LOOP:\r
-\r
-\r
- SET.ACTIVE.PAGE CurrentPage\r
-\r
- ' Erase Old Images\r
-\r
- FOR X = 1 TO LastObjects(CurrentPage)\r
- \r
- X1 = LastX(X, CurrentPage) AND &HFFFC\r
- Y1 = LastY(X, CurrentPage)\r
- X2 = ((LastX(X, CurrentPage) + Img(Obj(X).Shape).xWidth)) OR 3\r
- Y2 = Y1 + Img(Obj(X).Shape).yWidth - 1\r
-\r
- COPY.BITMAP 2, X1, Y1, X2, Y2, CurrentPage, X1, Y1\r
- \r
- NEXT X\r
-\r
- ' Draw new images\r
-\r
- FOR X = 1 TO VisObjects\r
-\r
- SpriteX = Img(Obj(X).Shape).xWidth\r
- SpriteY = Img(Obj(X).Shape).yWidth\r
-\r
- ' Move Sprite\r
-\r
-REDOX:\r
- NewX = Obj(X).Xpos + Obj(X).XDir\r
- IF NewX < 0 OR NewX + SpriteX > ScreenX THEN\r
- Obj(X).XDir = -Obj(X).XDir\r
- IF RANDOM.INT(20) = 1 THEN\r
- DO\r
- Obj(X).XDir = RANDOM.INT(7) - 3\r
- Obj(X).YDir = RANDOM.INT(7) - 3\r
- LOOP WHILE (Obj(X).XDir = 0 AND Obj(X).YDir = 0)\r
- GOTO REDOX\r
- END IF\r
- END IF\r
- Obj(X).Xpos = Obj(X).Xpos + Obj(X).XDir\r
-\r
-REDOY:\r
- NewY = Obj(X).Ypos + Obj(X).YDir\r
- IF NewY < 0 OR NewY + SpriteY > ScreenY THEN\r
- Obj(X).YDir = -Obj(X).YDir\r
- IF RANDOM.INT(20) = 1 THEN\r
- DO\r
- Obj(X).XDir = RANDOM.INT(7) - 3\r
- Obj(X).YDir = RANDOM.INT(7) - 3\r
- LOOP WHILE (Obj(X).XDir = 0 AND Obj(X).YDir = 0)\r
- GOTO REDOY\r
- END IF\r
- END IF\r
- Obj(X).Ypos = Obj(X).Ypos + Obj(X).YDir\r
-\r
- 'Draw Sprite\r
-\r
- TDRAW.BITMAP Img(Obj(X).Shape), Obj(X).Xpos, Obj(X).Ypos, SpriteX, SpriteY\r
-\r
- LastX(X, CurrentPage) = Obj(X).Xpos\r
- LastY(X, CurrentPage) = Obj(X).Ypos\r
-\r
- NEXT X\r
-\r
- LastObjects(CurrentPage) = VisObjects\r
-\r
- ' Pan Screen Back & Forth\r
-\r
- ViewCnt = ViewCnt + 1\r
- IF ViewCnt >= ViewMax THEN\r
- ViewX = ViewX + ViewXD\r
- IF ViewX = 0 OR ViewX = 39 THEN ViewXD = -ViewXD\r
- IF ViewXD < 0 THEN\r
- ViewY = ViewY + ViewYD\r
- IF ViewY = 0 OR ViewY = 39 THEN ViewYD = -ViewYD\r
- END IF\r
- \r
- SET.WINDOW CurrentPage, ViewX, ViewY\r
-\r
- ViewCnt = 0\r
- ELSE\r
- SET.DISPLAY.PAGE CurrentPage\r
- END IF\r
-\r
- ' Cycle Colors\r
-\r
- SET.DAC.REGISTER 50 + PrevColor, 3 + PrevColor, 0, 60 - PrevColor\r
- SET.DAC.REGISTER 50 + SetColor, SetColor, 10, 63 - SetColor\r
-\r
- SET.DAC.REGISTER 150 + PrevColor, 3 + PrevColor, 0, 60 - PrevColor\r
- SET.DAC.REGISTER 150 + SetColor, 63, 63, SetColor\r
-\r
- SetColor = SetColor + SDir\r
- IF SetColor = 60 OR SetColor = 0 THEN SDir = -SDir\r
-\r
- PrevColor = PrevColor + PDir\r
- IF PrevColor = 60 OR PrevColor = 0 THEN PDir = -PDir\r
-\r
- CurrentPage = 1 - CurrentPage\r
-\r
- Code = SCAN.KEYBOARD\r
-\r
- IF Code = False THEN GOTO DRAW.LOOP\r
-\r
- IF Code = KyPlus THEN\r
- IF ViewMax < 12 THEN ViewMax = ViewMax + 1\r
- GOTO DRAW.LOOP\r
- END IF\r
-\r
- IF Code = KyMinus THEN\r
- IF ViewMax > 1 THEN ViewMax = ViewMax - 1\r
- IF ViewCnt >= ViewMax THEN ViewCnt = 0\r
- GOTO DRAW.LOOP\r
- END IF\r
-\r
- IF Code = KyUp THEN\r
- IF VisObjects < MaxSprites THEN VisObjects = VisObjects + 1\r
- GOTO DRAW.LOOP\r
- END IF\r
- \r
- IF Code = KyDown THEN\r
- IF VisObjects > 1 THEN VisObjects = VisObjects - 1\r
- GOTO DRAW.LOOP\r
- END IF\r
-\r
-\r
-END SUB\r
-\r
-SUB PRINT.TEXT (Text$, Xpos, Ypos, ColorF, ColorB)\r
-\r
- IF LEN(Text$) = 0 THEN EXIT SUB\r
- PRINT.STR VARSEG(Text$), SADD(Text$), LEN(Text$), Xpos, Ypos, ColorF, ColorB\r
-\r
-\r
-END SUB\r
-\r
-SUB TPRINT.TEXT (Text$, Xpos, Ypos, ColorF)\r
-\r
- IF LEN(Text$) = 0 THEN EXIT SUB\r
-\r
- TPRINT.STR VARSEG(Text$), SADD(Text$), LEN(Text$), Xpos, Ypos, ColorF\r
-\r
-END SUB\r
-\r
projects / 16.git / blobdiff