'===========================================================================
' Subject: VGA COLORS & PALETTES             Date: 05-15-99 (18:33)       
' Author:  Dieter Folger                     Code: PB                     
' Origin:  folger@bamberg.baynet.de        Packet: PB.ABC
'===========================================================================
  '***********************************
  '*      VGA Colors & Palettes      *
  '*       Colors Demo Program       *
  '*    Developed by Ray Ligocki     *
  '*  Programmed in QuickBASIC 4.5   *
  '*    F R E E W A R E ... enjoy    *
  '*                                 *
  '*    Converted to Power Basic     *
  '*      by Dieter Folger 1997      *
  '***********************************
ON ERROR GOTO ErrorHandle
SCREEN 12 ' VGA 640 X 480 X 16 colors
' Dimension and read draw character strings
DIM ch$(0:42)
FOR x = 0 TO 42: READ ch$(x): NEXT
FirstScreen
MainScreen
'Set preliminary colors for display
Blue = 63: Green = 43: Red = 63
SetPalette 1, 0, 0, Blue
SetPalette 2, 0, Green, 0
SetPalette 4, Red, 0, 0
SetPalette 13, Red, Green, Blue
PrintValue
Arrow$ = CHR$(25): Place = 19
LOCATE 18, Place: PRINT Arrow$

' Main loop - forces user to use arrow keys or quit and monitor palette
DO
     DO: a$ = INKEY$: LOOP UNTIL LEN(a$)
     IF LEN(a$) = 2 THEN a$ = RIGHT$(a$, 1)
     SELECT CASE a$
     CASE CHR$(77) 'right
         LOCATE 18, Place: PRINT " "
         INCR Place, 19
         IF Place > 57 THEN Place = 19
         LOCATE 18, Place: PRINT Arrow$
     CASE CHR$(75) 'left
         LOCATE 18, Place: PRINT " "
         DECR Place, 19
         IF Place < 19 THEN Place = 57
         LOCATE 18, Place: PRINT Arrow$
     CASE CHR$(72)
          IF Place = 57 THEN
             INCR Blue
             IF Blue > 63 THEN Blue = 0
             SetPalette 1, 0, 0, Blue
             PrintValue
          END IF
          IF Place = 38 THEN
             INCR Green
             IF Green > 63 THEN Green = 0
             SetPalette 2, 0, Green, 0
             PrintValue
          END IF
          IF Place = 19 THEN
             INCR Red
             IF Red > 63 THEN Red = 0
             SetPalette 4, Red, 0, 0
             PrintValue
          END IF
     CASE CHR$(80)
          IF Place = 57 THEN
             DECR Blue
             IF Blue < 0 THEN Blue = 63
             PrintValue
             SetPalette 1, 0, 0, Blue
          END IF
          IF Place = 38 THEN
             DECR Green
             IF Green < 0 THEN Green = 63
             SetPalette 2, 0, Green, 0
             PrintValue
          END IF
          IF Place = 19 THEN
             DECR Red
             IF Red < 0 THEN Red = 63
             SetPalette 4, Red, 0, 0
             PrintValue
          END IF
     CASE "Q", "q", CHR$(27)
          END
     END SELECT
     SetPalette 13, Red, Green, Blue
LOOP

'Data for characters
DATA brhu4erfd4gnlbr2
DATA r2u6ngd6r2
DATA bu5er2fdgl2gd2r4
DATA bu5er2fdgnlfdgl2nhbr3
DATA br3u6g3r4bd3
DATA bufr2eu2hl3u2r4bd6
DATA bu3r3fdgl2hu4er2bd6br
DATA bu6r4dg3d2br3
DATA brhuer2euhl2gdfr2fdgnl2br
DATA brr2eu4hl2gdfr3bd3
DATA br4,br4,br4,br4,br4,br4,br4
DATA u5er2fd2nl4d3
DATA ru6nlr2fdgnl2fdgnl3br
DATA br4bu5hl2gd4fr2ebd
DATA ru6nlr2fd4gnl2br
DATA u6nr4d3nr3d3r4
DATA u3nr3u3r4bd6
DATA buu4er3bd4nld2l3nhr3
DATA u3nu3r4nu3d3
DATA r2u6nl2nr2d6r2
DATA bunufr2enu5bd
DATA u3nu3rne3f3
DATA nu6r4
DATA u6f2due2d6
DATA u6f4nu4d2
DATA brhu4er2fd4gnl2br
DATA u6r3fdgl3d3br4
DATA brhu4er2fd4gnl2buhf2
DATA u6r3fdgl3rf3
DATA bufr2euhl2huer2fbd5
DATA bu6r4l2d6br2
DATA bunu5fr2enu5bd
DATA bu6d4f2e2u4bd6
DATA nu6e2udf2nu6
DATA ue4nug2h2nuf4d
DATA bu6df2e2nug2d3br2
DATA bu6r4dg4dr4

ErrorHandle:
 CLS : PRINT "This program is for VGA only !"
 PRINT "Sorry .............."
END
'---------------------------------
SUB SetPalette (BYVAL C?, r, g, b)
'---------------------------------
  LOCAL Col?
  ! mov ax,&h1007
  ! mov bl,C?
  ! Int &h10
  ! mov Col?,bh
  OUT &H3C8, Col?
  OUT &H3C9, r
  OUT &H3C9, g
  OUT &H3C9, b
END SUB
'-------------
SUB PrintValue
'-------------
 ' print values held in Blue, Green and Red variable
 SHARED Blue, Red, Green
 LOCATE 22, 62: PRINT Blue
 LOCATE 22, 43: PRINT Green
 LOCATE 22, 24: PRINT Red
END SUB
'--------------
SUB FirstScreen
'--------------
 LINE (130, 100)-(520, 200), 1, BF
 LINE (131, 101)-(519, 199), 14, B
 LINE (133, 103)-(517, 197), 14, B
 DRAW "bm162,145c0s20": m$ = "VGA COLORS": WriteChar m$
 DRAW "bm163,145": WriteChar m$
 DRAW "bm164,145": WriteChar m$
 DRAW "bm155,148c14": WriteChar m$
 DRAW "bm156,148": WriteChar m$
 DRAW "bm157,148": WriteChar m$
 DRAW "bm246,180s4c14": m$ = "DEVELOPED BY RAY LIGOCKI": WriteChar m$
 DRAW "bm210,430s8c12": m$ = "THIS IS FREEWARE": WriteChar m$
 LOCATE 15, 16
 PRINT "Originally programmed in QuickBASIC 4.5 (April 1990)"
 LOCATE 16, 17
 PRINT "Converted to Power Basic by D. Folger (April 1997)"
 LOCATE 24, 35: PRINT "Press a key"
 DO: K$ = INKEY$: LOOP UNTIL LEN(K$)
END SUB
'-------------
SUB MainScreen
'-------------
 CLS
 LINE (0, 0)-(639, 40), 15, BF
 LINE (2, 2)-(637, 38), 1, B
 m$ = "THE PALETTE SHOP"
 DRAW "bm80,35c12s16": WriteChar m$
 v = 34
 FOR x = 81 TO 86
     DRAW "bm" + STR$(x) + "," + STR$(v): v = v - 1
     WriteChar m$
 NEXT x
 ' Draw paint cans
 CIRCLE (150, 360), 30, 7, 3, , .6
 CIRCLE (150, 310), 30, 7, , , .6
 CIRCLE (150, 310), 25, 7, , , .6
 DRAW "bm120,310s4c7d50br60u50"
 PAINT (150, 310), 4, 7
 PAINT (150, 330), 14, 7
 CIRCLE (150, 350), 26, 4, , , .6
 PAINT (150, 350), 15, 4
 DRAW "bm137,346c0": m$ = "LIGO": WriteChar m$
 DRAW "bm134,356": m$ = "PAINT": WriteChar m$
 DRAW "bm148,359c4r4fl6gr8gl6fr4"
 CIRCLE (300, 360), 30, 7, 3, , .6
 CIRCLE (300, 310), 30, 7, , , .6
 CIRCLE (300, 310), 25, 7, , , .6
 DRAW "bm270,310s4c7d50br60u50"
 PAINT (300, 310), 2, 7
 PAINT (300, 330), 14, 7
 CIRCLE (300, 350), 26, 4, , , .6
 PAINT (300, 350), 15, 4
 DRAW "bm287,346c0": m$ = "LIGO": WriteChar m$
 DRAW "bm284,356": m$ = "PAINT": WriteChar m$
 DRAW "bm298,359c2r4fl6gr8gl6fr4"
 CIRCLE (450, 360), 30, 7, 3, , .6
 CIRCLE (450, 310), 30, 7, , , .6
 CIRCLE (450, 310), 25, 7, , , .6
 DRAW "bm420,310s4c7d50br60u50"
 PAINT (450, 310), 1, 7
 PAINT (450, 330), 14, 7
 CIRCLE (450, 350), 26, 4, , , .6
 PAINT (450, 350), 15, 4
 DRAW "bm437,346c0": m$ = "LIGO": WriteChar m$
 DRAW "bm434,356": m$ = "PAINT": WriteChar m$
 DRAW "bm448,359c1r4fl6gr8gl6fr4"
 ' User instructions
 LOCATE 16, 4
 PRINT "Use " + CHR$(27) + CHR$(26) + " keys to select paint color & ";
 PRINT CHR$(18) + " keys for brightness control."
 'Draw pipe from bottom of cans to top of test tile
 DRAW "bm146,380c1d30f10r420e10u330h10l270g10d20r10u15e5r260f5d318g5l116u29l10d29l140u29l10d29l134h5u24l10"
 PAINT (150, 382), 7, 1
 ' Create a brown border around the test tile
 LINE (80, 100)-(560, 220), 15, B
 LINE (92, 122)-(548, 206), 15, B
 PAINT (90, 105), 6, 15
 ' Draw boxes and fill with default colors
 DRAW "bm600,100c15d320r20u20nl20u20nl20u20nl20u20nl20u20nl20u20nl20u20nl20u20nl20u20nl20u20nl20u20nl20u20nl20u20nl20u20nl20u20nl20u20l20"
 v = 125: FOR x = 1 TO 15: PAINT (610, v), x, 15: v = v + 20: NEXT x
 v = 112: FOR x = 0 TO 15: DRAW "bm618," + STR$(v) + "c15s4": m$ = STR$(x): WriteChar m$: v = v + 20: NEXT
 DRAW "bm590,432s4c15": m$ = "DEFAULT"
 WriteChar m$: DRAW "bm594,442": m$ = "COLORS": WriteChar m$
 ' Show off my handle
 DRAW "bm135,117s8c15"
 m$ = "LIGO PAINT COMPANY TEST TILE": WriteChar m$
 DRAW "bm94,124c12s4r451d80l225nu80l226u80"
 PAINT (100, 130), 15, 12
 ' put color for palette 13 on a white and black background
 LINE (116, 138)-(300, 190), 13, BF
 LINE (344, 138)-(524, 190), 13, BF
 ' More user information
 LOCATE 30, 29: PRINT "Press Q or Esc to quit";
 LOCATE 28, 16
 PRINT "64 X 64 X 64 = 262,144 possible color combinations !"
 LOCATE 4, 5
 PRINT "Command: SetPalette 13, Red, Green, Blue (I am changing color 13)"
END SUB
'-----------------
SUB WriteChar (m$)
'-----------------
' Draw character subprogram
 SHARED ch$()
 FOR z = 1 TO LEN(m$)
     m = ASC(MID$(m$, z, 1)) - 48
     IF m = -16 THEN DRAW "br4" ELSE DRAW ch$(m)
     DRAW "br3"
 NEXT z
END SUB
'=== eof =================================================================