16/modex/demos/basic7/chardemo.bas

   1 DEFINT A-Z\r
   2 DECLARE SUB PRINT.STRING (Text$, Xpos%, Ypos%, Colour%)\r
   3 DECLARE FUNCTION MakePal$ (Red%, Green%, Blue%)\r
   4 DECLARE SUB LOAD.FONT (FontFile$, FontNum%)\r
   5 DECLARE SUB ERROR.OUT (Text$)\r
   6 \r
   7         REM $INCLUDE: 'MODEX.BI'\r
   8 \r
   9         REM $INCLUDE: 'UTILS.BI'\r
  10 \r
  11 TYPE FONT\r
  12         SetData AS STRING * 1024\r
  13 END TYPE\r
  14 \r
  15 \r
  16 TYPE VGAPalette\r
  17         PalData AS STRING * 768\r
  18 END TYPE\r
  19 \r
  20 \r
  21         ' Alternate form of LOAD_DAC_REGISTERS so we can pass an offset into\r
  22         ' a String instead of the Address of the String\r
  23 \r
  24 DECLARE SUB LOAD.DACS ALIAS "LOAD_DAC_REGISTERS" (BYVAL Addr&, BYVAL StartReg%, BYVAL EndReg%, BYVAL VSync%)\r
  25 \r
  26 \r
  27         '\r
  28         'MODE X DEMO of Multiple Character Sets and Block Color Cycling\r
  29         '\r
  30         'By Matt Pritchard\r
  31         '\r
  32 \r
  33 COMMON SHARED CharSet() AS FONT\r
  34 \r
  35 DIM Pal AS VGAPalette\r
  36 \r
  37         REM $DYNAMIC\r
  38 \r
  39 DIM SHARED CharSet(0 TO 3) AS FONT\r
  40 \r
  41 \r
  42         LOAD.FONT "SYSTEM.FNT", 0\r
  43         LOAD.FONT "ROM_8x8.FNT", 1\r
  44         LOAD.FONT "SPACEAGE.FNT", 2\r
  45 \r
  46 \r
  47         IF SET.MODEX(Mode320x240) = False THEN\r
  48                 ERROR.OUT "ERROR SETTING MODE X"\r
  49         END IF\r
  50 \r
  51 \r
  52         A$ = "": B$ = ""\r
  53         FOR X = 0 TO 31: A$ = A$ + MakePal$(31 - X, X, 0): NEXT X\r
  54         FOR X = 0 TO 31: A$ = A$ + MakePal$(0, 31 - X, X): NEXT X\r
  55         FOR X = 0 TO 31: A$ = A$ + MakePal$(X, 0, 31 - X): NEXT X\r
  56    \r
  57         FOR X = 0 TO 31: B$ = B$ + MakePal$(31 - X, X, X): NEXT X\r
  58         FOR X = 0 TO 31: B$ = B$ + MakePal$(X, 31 - X, X): NEXT X\r
  59         FOR X = 0 TO 31: B$ = B$ + MakePal$(X, X, 31 - X): NEXT X\r
  60 \r
  61         Black$ = STRING$(192, 0)\r
  62         White$ = STRING$(128 * 3, 48)\r
  63 \r
  64         Pal1$ = Black$ + A$ + A$ + B$ + B$ + A$\r
  65 \r
  66         LOAD.DACS SSEGADD(Black$), 64, 127, 1\r
  67         LOAD.DACS SSEGADD(Black$), 20, 63, 0\r
  68 \r
  69         LOAD.DACS SSEGADD(White$), 128, 255, 0\r
  70 \r
  71         '*** Background ***\r
  72 \r
  73         FOR X = 0 TO 319\r
  74                 FOR Y = 0 TO 239\r
  75                    IF ((X + Y) AND 1) = 1 THEN SET.POINT X, Y, 64 + X \ 5 ELSE SET.POINT X, Y, 20 + Y \ 6\r
  76                 NEXT Y\r
  77         NEXT X\r
  78 \r
  79         '*** Draw Font Displays ***\r
  80 \r
  81         PRINT.STRING "FONT: SYSTEM.FNT", 11, 7, 15\r
  82         PRINT.STRING "FONT: ROM_8x8.FNT", 11, 17, 15\r
  83         PRINT.STRING "FONT: SPACEAGE.FNT", 11, 27, 15\r
  84         PRINT.STRING "PRESS ANY KEY TO CONTINUE", 8, 29, 14\r
  85         \r
  86 \r
  87         FOR F = 0 TO 2\r
  88                 SET.DISPLAY.FONT CharSet(F), 1\r
  89                 Yp = F * 80 + 10\r
  90                 FOR Y = 0 TO 96 STEP 32\r
  91                         FOR X = 0 TO 31\r
  92                                 TGPRINTC 128 + Y + X, X * 10 + 1, Yp, 128 + Y\r
  93                         NEXT X\r
  94                 Yp = Yp + 10\r
  95                 NEXT Y\r
  96         NEXT F\r
  97 \r
  98         DO\r
  99         LOOP UNTIL SCAN.KEYBOARD\r
 100 \r
 101         Offset = 0\r
 102         Restart = 192\r
 103         MaxOfs = 192 + 96 * 6\r
 104 \r
 105         Delay = 100\r
 106 \r
 107         Offset2 = 0\r
 108         Offset2Dir = 3\r
 109         Offset2Min = 192\r
 110         Offset2Max = Offset2Min + 192 * 6\r
 111 \r
 112         DO\r
 113                 LOAD.DACS SSEGADD(Pal1$) + Offset, 64, 127, 1\r
 114                 Offset = Offset + 3\r
 115                 IF Offset >= MaxOfs THEN Offset = Restart\r
 116                 IF Delay THEN\r
 117                         Delay = Delay - 1\r
 118                 ELSE\r
 119                         LOAD.DACS SSEGADD(Pal1$) + Offset2, 20, 60, 0\r
 120                         IF Offset2 = Offset2Max THEN Offset2Dir = -3\r
 121                         IF Offset2 = Offset2Min THEN Offset2Dir = 3\r
 122                         Offset2 = Offset2 + Offset2Dir\r
 123                 END IF\r
 124 \r
 125         LOOP UNTIL SCAN.KEYBOARD\r
 126 \r
 127         ERROR.OUT "DEMO OVER"\r
 128 \r
 129 REM $STATIC\r
 130 SUB ERROR.OUT (Text$)\r
 131 \r
 132         SET.VIDEO.MODE 3\r
 133 \r
 134         DOS.PRINT Text$\r
 135 \r
 136         END\r
 137 \r
 138 END SUB\r
 139 \r
 140 SUB LOAD.FONT (FontFile$, FontNum) STATIC\r
 141 \r
 142         IF LEN(DIR$(FontFile$)) = 0 THEN ERROR.OUT "FILE NOT FOUND: " + FontFile$\r
 143 \r
 144         OPEN FontFile$ FOR BINARY AS #1\r
 145 \r
 146                 SEEK #1, 1\r
 147                 GET #1, , CharSet(FontNum)\r
 148 \r
 149         CLOSE #1\r
 150 \r
 151 END SUB\r
 152 \r
 153 FUNCTION MakePal$ (Red, Green, Blue) STATIC\r
 154 \r
 155         MakePal$ = CHR$(Red) + CHR$(Green) + CHR$(Blue)\r
 156 \r
 157 END FUNCTION\r
 158 \r
 159 SUB PRINT.STRING (Text$, Xpos, Ypos, Colour)\r
 160 \r
 161         TPRINT.STR SSEG(Text$), SADD(Text$), LEN(Text$), Xpos * 8, Ypos * 8, Colour\r
 162 \r
 163 END SUB\r
 164 \r