X-Git-Url: http://4ch.mooo.com/gitweb/?a=blobdiff_plain;f=src%2Flib%2Fmodex%2Fdemos%2Fbasic7%2Ftest6.bas;fp=src%2Flib%2Fmodex%2Fdemos%2Fbasic7%2Ftest6.bas;h=220a67baad317749148adce612e40fcae2eb92ec;hb=75a35fd2843da7105acc7eee68674131431d0ccb;hp=0000000000000000000000000000000000000000;hpb=1c75464b9fad87da35a11650cab4e63aa532e5fc;p=16.git

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