+++ /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