montest.bas with syntax coloring

This HTML file was generated with Kalle's syntaxcolor.py


   1DECLARE SUB rectangles (mode%, wid%, hei%)
   2DECLARE SUB onecolorscreen (colr%)
   3DECLARE SUB patternfill (mode%, patternline1%, patternline2%)
   4DECLARE SUB geometry (mode%, wid%, hei%)
   5DECLARE SUB gradients (shadecnt%)
   6DECLARE SUB fullsaturation ()
   7DECLARE SUB printmainmenu ()
   8DECLARE FUNCTION runtest% (key$)
   9
  10DO
  11    SCREEN 0
  12    WIDTH 80
  13    PALETTE
  14    COLOR 7, 0
  15    CLS
  16
  17    printmainmenu
  18
  19    DO
  20        key$ = UCASE$(INPUT$(1))
  21        IF key$ = CHR$(27) THEN
  22            CLS
  23            END
  24        END IF
  25    LOOP UNTIL runtest%(key$)
  26
  27    key$ = INPUT$(1)
  28LOOP
  29
  30SUB fullsaturation
  31
  32' There are six basic colors in the gradient: red, yellow, green, cyan,
  33' blue and magenta. Each transition between them is 42 shades. Thus, the
  34' total number of colors is 6 * 42 = 252.
  35
  36DIM shades%(41)
  37
  38FOR i% = 0 TO 41
  39    ' shade = round(i% / 42 * 63)
  40    shades%(i%) = i% * 3 \ 2
  41NEXT
  42
  43DIM colors&(255)
  44
  45FOR i% = 0 TO 41
  46    red& = shades%(i%)
  47    green& = shades%(i%) * &H100
  48    blue& = shades%(i%) * &H10000
  49
  50    ' red to yellow, yellow to green, etc.
  51    colors&(i%) = &H3F& + green&
  52    colors&(42 + i%) = &H3F3F& - red&
  53    colors&(84 + i%) = &H3F00& + blue&
  54    colors&(126 + i%) = &H3F3F00 - green&
  55    colors&(168 + i%) = &H3F0000 + red&
  56    colors&(210 + i%) = &H3F003F - blue&
  57NEXT
  58
  59' black for unused pixels
  60colors&(252) = &H0
  61
  62SCREEN 13
  63PALETTE USING colors&
  64
  65' fill screen with black
  66LINE (0, 0)-(319, 199), 252, BF
  67
  68' draw vertical colored lines
  69FOR i% = 0 TO 251
  70    x% = 34 + i%
  71    LINE (x%, 0)-(x%, 199), i%
  72NEXT
  73
  74END SUB
  75
  76SUB geometry (mode%, wid%, hei%)
  77
  78' a circle on a grid of 8x6 squares
  79
  80SCREEN mode%
  81
  82' vertical lines
  83FOR i% = 0 TO 8
  84    x% = i% * (wid% - 1) \ 8
  85    LINE (x%, 0)-(x%, hei% - 1), 15
  86NEXT
  87
  88' horizontal lines
  89FOR i% = 0 TO 6
  90    y% = i% * (hei% - 1) \ 6
  91    LINE (0, y%)-(wid% - 1, y%), 15
  92NEXT
  93
  94' circle
  95aspect! = (4 / 3) / (wid% / hei%)
  96radius% = hei% / aspect! \ 2 - 1
  97CIRCLE (wid% \ 2 - 1, hei% \ 2 - 1), radius%, 15, , , aspect!
  98
  99END SUB
 100
 101SUB gradients (shadecnt%)
 102
 103' gradient from black to red/green/blue/white
 104' shadecnt% = number of shades per gradient
 105
 106DIM shades%(63)
 107
 108SELECT CASE shadecnt%
 109    CASE 4
 110        FOR i% = 0 TO 3
 111            ' shade = round(i% / 3 * 63)
 112            shades%(i%) = i% * 21
 113        NEXT
 114    CASE 8
 115        FOR i% = 0 TO 7
 116            ' shade = round(i% / 7 * 63)
 117            shades%(i%) = i% * 9
 118        NEXT
 119    CASE 16
 120        FOR i% = 0 TO 15
 121            ' shade = round(i% / 15 * 63)
 122            shades%(i%) = (i% * 126 + 15) \ 30
 123        NEXT
 124    CASE 32
 125        FOR i% = 0 TO 31
 126            ' shade = round(i% / 31 * 63)
 127            shades%(i%) = (i% * 126 + 31) \ 62
 128        NEXT
 129    CASE 64
 130        FOR i% = 0 TO 63
 131            shades%(i%) = i%
 132        NEXT
 133    CASE ELSE
 134        PRINT "error"
 135        END
 136END SELECT
 137
 138SCREEN 13
 139
 140FOR i% = 0 TO shadecnt% - 1
 141    shade% = shades%(i%)
 142
 143    PALETTE i%, shade% * &H1
 144    PALETTE shadecnt% + i%, shade% * &H100
 145    PALETTE 2 * shadecnt% + i%, shade% * &H10000
 146    PALETTE 3 * shadecnt% + i%, shade% * &H10101
 147NEXT
 148
 149columnwidth% = 320 \ shadecnt%
 150
 151FOR y% = 0 TO 3
 152    FOR x% = 0 TO shadecnt%
 153        x1% = x% * columnwidth%
 154        x2% = (x% + 1) * columnwidth% - 1
 155        y1% = y% * 50
 156        y2% = y% * 50 + 49
 157        colour% = y% * shadecnt% + x%
 158
 159        LINE (x1%, y1%)-(x2%, y2%), colour%, BF
 160    NEXT
 161NEXT
 162
 163END SUB
 164
 165SUB onecolorscreen (colr%)
 166
 167PALETTE 0, colr%
 168COLOR , 0
 169CLS
 170
 171END SUB
 172
 173SUB patternfill (mode%, patternline1%, patternline2%)
 174
 175' fill screen with a custom 8*2-pixel pattern of bright white and black
 176
 177SCREEN mode%
 178
 179pattern$ = STRING$(4, patternline1%) + STRING$(4, patternline2%)
 180PAINT (0, 0), pattern$
 181
 182END SUB
 183
 184SUB printmainmenu
 185
 186COLOR 14
 187PRINT "Monitor tester by Kalle"
 188COLOR 7
 189PRINT
 190COLOR 15
 191PRINT "Geometry (circle on a grid of 8x6 squares):"
 192COLOR 7
 193PRINT "  A: 640x480, B: 640x350, C: 640x200, D: 320x200"
 194COLOR 15
 195PRINT "Crosshatch pattern:"
 196COLOR 7
 197PRINT "  E: 640x480, F: 640x350, G: 640x200, H: 320x200"
 198COLOR 15
 199PRINT "Vertical lines:"
 200COLOR 7
 201PRINT "  I: 640x480, J: 640x350, K: 640x200, L: 320x200"
 202COLOR 15
 203PRINT "Horizontal lines:"
 204COLOR 7
 205PRINT "  M: 640x480, N: 640x350, O: 320x200"
 206COLOR 15
 207PRINT "Concentric rectangles:"
 208COLOR 7
 209PRINT "  P: 640x480, Q: 640x350, R: 640x200, S: 320x200"
 210PRINT
 211
 212COLOR 15
 213PRINT "One-color screen (text mode):"
 214COLOR 7
 215PRINT "  T: black, U: red, V: yellow, W: green, X: cyan, Y: blue, ";
 216PRINT "Z: magenta, 0: white"
 217COLOR 15
 218PRINT "Gradient (black to red/green/blue/white) (320x200 mode):"
 219COLOR 7
 220PRINT "  1: 64 shades, 2: 32 shades, 3: 16 shades, 4: 8 shades, 5: 4 shades"
 221COLOR 15
 222PRINT "Miscellaneous:"
 223COLOR 7
 224PRINT "  6: gradient of fully saturated colors (320x200, 252 colors)"
 225PRINT
 226PRINT "Esc: quit"
 227
 228END SUB
 229
 230SUB rectangles (mode%, wid%, hei%)
 231
 232' concentric rectangles
 233
 234SCREEN mode%
 235
 236loopmax% = hei% \ 2 - 2
 237
 238FOR i% = 0 TO loopmax% STEP 2
 239    LINE (i%, i%)-(wid% - 1 - i%, hei% - 1 - i%), 15, B
 240NEXT
 241
 242END SUB
 243
 244FUNCTION runtest% (key$)
 245
 246' run test specified by key
 247' return 1 if a test was run, 0 if not
 248
 249testwasrun% = 1
 250
 251SELECT CASE key$
 252    CASE "A"
 253        CALL geometry(12, 640, 480)
 254    CASE "B"
 255        CALL geometry(9, 640, 350)
 256    CASE "C"
 257        CALL geometry(8, 620, 200)
 258    CASE "D"
 259        CALL geometry(7, 320, 200)
 260    CASE "E"
 261        CALL patternfill(12, &HAA, &H55)
 262    CASE "F"
 263        CALL patternfill(9, &HAA, &H55)
 264    CASE "G"
 265        CALL patternfill(8, &HAA, &H55)
 266    CASE "H"
 267        CALL patternfill(7, &HAA, &H55)
 268    CASE "I"
 269        CALL patternfill(12, &HAA, &HAA)
 270    CASE "J"
 271        CALL patternfill(9, &HAA, &HAA)
 272    CASE "K"
 273        CALL patternfill(8, &HAA, &HAA)
 274    CASE "L"
 275        CALL patternfill(7, &HAA, &HAA)
 276    CASE "M"
 277        CALL patternfill(12, &HFF, &H0)
 278    CASE "N"
 279        CALL patternfill(9, &HFF, &H0)
 280    CASE "O"
 281        CALL patternfill(7, &HFF, &H0)
 282    CASE "P"
 283        CALL rectangles(12, 640, 480)
 284    CASE "Q"
 285        CALL rectangles(9, 640, 350)
 286    CASE "R"
 287        CALL rectangles(8, 640, 200)
 288    CASE "S"
 289        CALL rectangles(7, 320, 200)
 290
 291    CASE "T"
 292        CALL onecolorscreen(&H0)  ' black
 293    CASE "U"
 294        CALL onecolorscreen(&H24)  ' red
 295    CASE "V"
 296        CALL onecolorscreen(&H36)  ' yellow
 297    CASE "W"
 298        CALL onecolorscreen(&H12)  ' green
 299    CASE "X"
 300        CALL onecolorscreen(&H1B)  ' cyan
 301    CASE "Y"
 302        CALL onecolorscreen(&H9)  ' blue
 303    CASE "Z"
 304        CALL onecolorscreen(&H2D)  ' magenta
 305    CASE "0"
 306        CALL onecolorscreen(&H3F)  ' white
 307    CASE "1"
 308        CALL gradients(64)
 309    CASE "2"
 310        CALL gradients(32)
 311    CASE "3"
 312        CALL gradients(16)
 313    CASE "4"
 314        CALL gradients(8)
 315    CASE "5"
 316        CALL gradients(4)
 317    CASE "6"
 318        CALL fullsaturation
 319
 320    CASE ELSE
 321        testwasrun% = 0
 322END SELECT
 323
 324runtest% = testwasrun%
 325
 326END FUNCTION
 327