--- /dev/null
+DEFINT A-Z\r
+DECLARE SUB PRINT.STRING (Text$, Xpos%, Ypos%, Colour%)\r
+DECLARE FUNCTION MakePal$ (Red%, Green%, Blue%)\r
+DECLARE SUB LOAD.FONT (FontFile$, FontNum%)\r
+DECLARE SUB ERROR.OUT (Text$)\r
+\r
+ REM $INCLUDE: 'MODEX.BI'\r
+\r
+ REM $INCLUDE: 'UTILS.BI'\r
+\r
+TYPE FONT\r
+ SetData AS STRING * 1024\r
+END TYPE\r
+\r
+\r
+TYPE VGAPalette\r
+ PalData AS STRING * 768\r
+END TYPE\r
+\r
+\r
+ ' Alternate form of LOAD_DAC_REGISTERS so we can pass an offset into\r
+ ' a String instead of the Address of the String\r
+\r
+DECLARE SUB LOAD.DACS ALIAS "LOAD_DAC_REGISTERS" (BYVAL Addr&, BYVAL StartReg%, BYVAL EndReg%, BYVAL VSync%)\r
+\r
+\r
+ '\r
+ 'MODE X DEMO of Multiple Character Sets and Block Color Cycling\r
+ '\r
+ 'By Matt Pritchard\r
+ '\r
+\r
+COMMON SHARED CharSet() AS FONT\r
+\r
+DIM Pal AS VGAPalette\r
+\r
+ REM $DYNAMIC\r
+\r
+DIM SHARED CharSet(0 TO 3) AS FONT\r
+\r
+\r
+ LOAD.FONT "SYSTEM.FNT", 0\r
+ LOAD.FONT "ROM_8x8.FNT", 1\r
+ LOAD.FONT "SPACEAGE.FNT", 2\r
+\r
+\r
+ IF SET.MODEX(Mode320x240) = False THEN\r
+ ERROR.OUT "ERROR SETTING MODE X"\r
+ END IF\r
+\r
+\r
+ A$ = "": B$ = ""\r
+ FOR X = 0 TO 31: A$ = A$ + MakePal$(31 - X, X, 0): NEXT X\r
+ FOR X = 0 TO 31: A$ = A$ + MakePal$(0, 31 - X, X): NEXT X\r
+ FOR X = 0 TO 31: A$ = A$ + MakePal$(X, 0, 31 - X): NEXT X\r
+ \r
+ FOR X = 0 TO 31: B$ = B$ + MakePal$(31 - X, X, X): NEXT X\r
+ FOR X = 0 TO 31: B$ = B$ + MakePal$(X, 31 - X, X): NEXT X\r
+ FOR X = 0 TO 31: B$ = B$ + MakePal$(X, X, 31 - X): NEXT X\r
+\r
+ Black$ = STRING$(192, 0)\r
+ White$ = STRING$(128 * 3, 48)\r
+\r
+ Pal1$ = Black$ + A$ + A$ + B$ + B$ + A$\r
+\r
+ LOAD.DACS SSEGADD(Black$), 64, 127, 1\r
+ LOAD.DACS SSEGADD(Black$), 20, 63, 0\r
+\r
+ LOAD.DACS SSEGADD(White$), 128, 255, 0\r
+\r
+ '*** Background ***\r
+\r
+ FOR X = 0 TO 319\r
+ FOR Y = 0 TO 239\r
+ IF ((X + Y) AND 1) = 1 THEN SET.POINT X, Y, 64 + X \ 5 ELSE SET.POINT X, Y, 20 + Y \ 6\r
+ NEXT Y\r
+ NEXT X\r
+\r
+ '*** Draw Font Displays ***\r
+\r
+ PRINT.STRING "FONT: SYSTEM.FNT", 11, 7, 15\r
+ PRINT.STRING "FONT: ROM_8x8.FNT", 11, 17, 15\r
+ PRINT.STRING "FONT: SPACEAGE.FNT", 11, 27, 15\r
+ PRINT.STRING "PRESS ANY KEY TO CONTINUE", 8, 29, 14\r
+ \r
+\r
+ FOR F = 0 TO 2\r
+ SET.DISPLAY.FONT CharSet(F), 1\r
+ Yp = F * 80 + 10\r
+ FOR Y = 0 TO 96 STEP 32\r
+ FOR X = 0 TO 31\r
+ TGPRINTC 128 + Y + X, X * 10 + 1, Yp, 128 + Y\r
+ NEXT X\r
+ Yp = Yp + 10\r
+ NEXT Y\r
+ NEXT F\r
+\r
+ DO\r
+ LOOP UNTIL SCAN.KEYBOARD\r
+\r
+ Offset = 0\r
+ Restart = 192\r
+ MaxOfs = 192 + 96 * 6\r
+\r
+ Delay = 100\r
+\r
+ Offset2 = 0\r
+ Offset2Dir = 3\r
+ Offset2Min = 192\r
+ Offset2Max = Offset2Min + 192 * 6\r
+\r
+ DO\r
+ LOAD.DACS SSEGADD(Pal1$) + Offset, 64, 127, 1\r
+ Offset = Offset + 3\r
+ IF Offset >= MaxOfs THEN Offset = Restart\r
+ IF Delay THEN\r
+ Delay = Delay - 1\r
+ ELSE\r
+ LOAD.DACS SSEGADD(Pal1$) + Offset2, 20, 60, 0\r
+ IF Offset2 = Offset2Max THEN Offset2Dir = -3\r
+ IF Offset2 = Offset2Min THEN Offset2Dir = 3\r
+ Offset2 = Offset2 + Offset2Dir\r
+ END IF\r
+\r
+ LOOP UNTIL SCAN.KEYBOARD\r
+\r
+ ERROR.OUT "DEMO OVER"\r
+\r
+REM $STATIC\r
+SUB ERROR.OUT (Text$)\r
+\r
+ SET.VIDEO.MODE 3\r
+\r
+ DOS.PRINT Text$\r
+\r
+ END\r
+\r
+END SUB\r
+\r
+SUB LOAD.FONT (FontFile$, FontNum) STATIC\r
+\r
+ IF LEN(DIR$(FontFile$)) = 0 THEN ERROR.OUT "FILE NOT FOUND: " + FontFile$\r
+\r
+ OPEN FontFile$ FOR BINARY AS #1\r
+\r
+ SEEK #1, 1\r
+ GET #1, , CharSet(FontNum)\r
+\r
+ CLOSE #1\r
+\r
+END SUB\r
+\r
+FUNCTION MakePal$ (Red, Green, Blue) STATIC\r
+\r
+ MakePal$ = CHR$(Red) + CHR$(Green) + CHR$(Blue)\r
+\r
+END FUNCTION\r
+\r
+SUB PRINT.STRING (Text$, Xpos, Ypos, Colour)\r
+\r
+ TPRINT.STR SSEG(Text$), SADD(Text$), LEN(Text$), Xpos * 8, Ypos * 8, Colour\r
+\r
+END SUB\r
+\r
projects / 16.git / blobdiff