'===========================================================================
' Subject: TEXT PLASMA / TAKE TWO            Date: 10-31-97 (19:23)       
' Author:  Andrew S. Gibson                  Code: QB, PDS                
' Origin:  zapf_dingbat@juno.com           Packet: GRAPHICS.ABC
'===========================================================================
' * YOU MUST LOAD QuickBASIC 4.X WITH /L/AH TO USE THIS PROGRAM *
' * (This code should be BASIC Professional Development System 7.1 / VBDOS
' * (comapatible.)  If you can use this read all the comments before running *
'
' -----Compile this for maximum speed ! (after testing)
'
' This first appeared in the September ABC packet (09/97)
' Original TEXT PLASMA made by :
' omega, omega@inorbit.com
' buzz , buzz@ddsw.nl
'
' The major changes:
'
' o All screen maniplulation is either Direct Video Memory Access,
'   controlled by INP/OUT commands, and DOS function calls !
'
' o Reworked for EGA & VGA video systems using 2 scan lines per byte at
'   32k -- ALL of the color video segment (I think ?!) !!!!
'
' o More Plasma variants & possible colors !
'
'
' Disclamer: I hearby disclaim all warranties to the fitness of this
'            program - I cannot be held liable for unpredicted events
'            that may happen while you used the revised version of
'            Text Plasma. I have tested this on 2 computers and it
'            works, although I will not (cannot) garantee
'            functionality under your computer system's environment.
'
'TEXT PLASMA / TAKE TWO by Zapf_DingBat@JUNO.COM (It's my Email address)
'                          ^Please feel free to Write to me, I'll absorb your
'                           comments (by osmosis :}), but reserve any flames
'                           for a fire !

DEFINT A-Z
DECLARE FUNCTION Monitor% (VSSegment)
DECLARE SUB ColorSelect ()
DECLARE SUB GenLookupTables ()
DECLARE SUB Help ()
DECLARE SUB MakeGarbage ()
DECLARE SUB STDOUT (MESSAGETEXT$)
DECLARE SUB txtpalget (col%, R%, G%, B%)
DECLARE SUB txtpalset (col%, R%, G%, B%)

'REGTYPE.BAS - Include file for CALL INTERRUPT & CALL INTERRUPTX
TYPE RegType
  AX    AS INTEGER
  BX    AS INTEGER
  CX    AS INTEGER
  DX    AS INTEGER
  BP    AS INTEGER
  SI    AS INTEGER
  DI    AS INTEGER
  flags AS INTEGER
  DS    AS INTEGER
  ES    AS INTEGER
END TYPE

CLEAR , , 2048
' don't change the constants !
CONST PI = 3.14159265358979#, Spaces$ = "  "
DIM SHARED Registers AS RegType, SinusLimit, TextPlasVariant, ColoringMethod
DIM SHARED COSINUS#(0 TO 278), COSINUSx(0 TO 278), RAND(0 TO 278)

'test for help
IF COMMAND$ = "?" OR COMMAND$ = "/?" THEN Help
'test video capability
SELECT CASE Monitor%(SSeg)
       CASE 4, 5
         'set screen mode
         Registers.AX = &H3
         CALL InterruptX(&H10, Registers, Registers)
         OUT &H3D4, 9: OUT &H3D5, 1  'Fourteen Scan lines
         Registers.AX = &H1003 'turn blinking off !
         Registers.BX = &H0
         CALL InterruptX(&H10, Registers, Registers)
       CASE ELSE
           STDOUT "VGA or EGA Graphics adapter is required to run Text Plasma." + CHR$(10) + CHR$(13)
END SELECT

'Seed the psuedo-random number generator with the current time.
DEF SEG = &H40
NewSeed& = PEEK(&H6C) + PEEK(&H6D) * 256& + PEEK(&H6E) * 65536
DEF SEG
RANDOMIZE NewSeed&

' blank screen
FOR Blank = 0 TO 63
    txtpalset Blank, 0, 0, 0
NEXT

TextPlasVariant = INT(RND * 10) ' select Text Plasma Variant
GenLookupTables
MakeGarbage 'create random pixels
ColoringMethod = INT(RND * 13) ': ColoringMethod = 13 'used for testing
ColorSelect 'select colors

WAVESIDE1 = RND * 1: IF WAVESIDE1 = 0 THEN WAVESIDE1 = 1: 'prevent 0 movement initially
WAVESIDE2 = RND * 3: IF WAVESIDE2 = 0 THEN WAVESIDE2 = 1: ' ""
WAVESIDE3 = RND * 2: IF WAVESIDE3 = 0 THEN WAVESIDE3 = 1: ' ""
R1 = RND * 5: IF R1 = 0 THEN R1 = 1: 'prevent 0 movement initially
R2 = RND * 15: IF R2 = 0 THEN R2 = 1: ' ""
R3 = RND * 35: IF R3 = 0 THEN R3 = 1: ' ""
Method = INT(RND * 6) 'choose form of sinus clipping
DEF SEG = &HB800
DO
    WAVE1 = WAVE1 + WAVESIDE1
    IF WAVE1 >= SinusLimit THEN
        WAVE1 = 0
        SELECT CASE Method
         CASE IS = 0
          R1 = (R1 + 1) AND 255
         CASE IS = 1
          R1 = (R1 + 1) OR 255
         CASE IS = 2
          R1 = (R1 + 1) XOR 255
         CASE IS = 3
          R1 = (R1 + 1) IMP 255
         CASE IS = 4
          R1 = (R1 + 1) EQV 255
         CASE IS = 5
          R1 = (R1 + 1) MOD 255
         CASE IS = 6
          R1 = (R1 + 1) 'basic
         END SELECT
         'prevent ubound array overflow
         IF R1 < -278 THEN R1 = 0
         IF R1 > 278 THEN R1 = 278
         WAVESIDE1 = RAND(ABS(R1))
    END IF
    WAVE2 = WAVE2 + WAVESIDE2
    IF WAVE2 >= SinusLimit THEN
        WAVE2 = 0
        SELECT CASE Method
         CASE IS = 0
          R2 = (R2 + 2) AND 255
         CASE IS = 1
          R2 = (R2 + 2) OR 255
         CASE IS = 2
          R2 = (R2 + 2) XOR 255
         CASE IS = 3
          R2 = (R2 + 2) IMP 255
         CASE IS = 4
          R2 = (R2 + 2) EQV 255
         CASE IS = 5
          R2 = (R2 + 2) MOD 255
         CASE IS = 6
          R2 = (R2 + 2)
         END SELECT
         'prevent ubound array overflow
         IF R2 < -278 THEN R2 = 0
         IF R2 > 278 THEN R2 = 278
         WAVESIDE2 = RAND(ABS(R2))
    END IF
    WAVE3 = WAVE3 + WAVESIDE3
    IF WAVE3 >= SinusLimit THEN
        WAVE3 = 0
        SELECT CASE Method
         CASE IS = 0
          R3 = (R3 + 2) AND 255
         CASE IS = 1
          R3 = (R3 + 2) OR 255
         CASE IS = 2
          R3 = (R3 + 2) XOR 255
         CASE IS = 3
          R3 = (R3 + 2) IMP 255
         CASE IS = 4
          R3 = (R3 + 2) EQV 255
         CASE IS = 5
          R3 = (R3 + 2) MOD 255
         CASE IS = 6
          R3 = (R3 + 2)
         END SELECT
         'prevent ubound array overflow
         IF R3 < -278 THEN R3 = 0
         IF R3 > 278 THEN R3 = 278
         WAVESIDE3 = RAND(ABS(R3))
    END IF
    FOR I = 1 TO 2
    WAIT &H3DA, 8, 8
    WAIT &H3DA, 8, 0
    NEXT I
'**********************************DON'T CHANGE !!***************************************
    Position = 1
    FOR Y = 0 TO 199
        E = COSINUSx(Y + WAVE1)
        FOR X = 0 TO 79
              col = COSINUSx(X + WAVE2) + E + COSINUSx(X + WAVE3) + COSINUSx(X + Y)
            POKE Position, col
            Position = Position + 2
        NEXT X
    NEXT Y
'****************************************************************************************     

     XXXX$ = UCASE$(INKEY$)
'    Scancode = INP(96) 'a cheap easy way to recognize scan codes - unused
    IF XXXX$ = CHR$(27) THEN 'Exit
        Registers.AX = &H1003 'turn blinking on !
        Registers.BX = &H1
        CALL InterruptX(&H10, Registers, Registers)
        'set screen mode
        Registers.AX = &H0
        CALL InterruptX(&H10, Registers, Registers)
        Registers.AX = &H3
        CALL InterruptX(&H10, Registers, Registers)
        EXIT DO
    END IF
    IF XXXX$ = CHR$(71) THEN 'New Garbage
       MakeGarbage
       DEF SEG = &HB800
    END IF
    IF XXXX$ = CHR$(73) THEN 'Invert Palette
       FOR IC = 0 TO 63
        OUT &H3C7, IC: red = INP(&H3C9): green = INP(&H3C9): Blue = INP(&H3C9)
        OUT &H3C8, IC: OUT &H3C9, NOT red: OUT &H3C9, NOT green: OUT &H3C9, NOT Blue
       NEXT IC
    END IF
    IF XXXX$ = CHR$(78) THEN 'New palette
       ColoringMethod = INT(RND * 13)
       'ColoringMethod = 13 'used for testing
       ColorSelect
    END IF
    IF XXXX$ = CHR$(84) THEN 'New Tables
       'comment the line below if want a different sinus limit
       TextPlasVariant = INT(RND * 10) ' select Text Plasma Variant
       GenLookupTables
    END IF
    IF XXXX$ = CHR$(127) THEN 'Restart
        DEF SEG
        Registers.AX = &H1003 'turn blinking on !
        Registers.BX = &H1
        CALL InterruptX(&H10, Registers, Registers)
        'set screen mode
        Registers.AX = &H0
        CALL InterruptX(&H10, Registers, Registers)
        Registers.AX = &H3
        CALL InterruptX(&H10, Registers, Registers)
        CLEAR : RUN
    END IF
    IF XXXX$ = CHR$(22) THEN 'Variable dump - used for debugging
        DEF SEG
        Registers.AX = &H1003 'turn blinking on !
        Registers.BX = &H1
        CALL InterruptX(&H10, Registers, Registers)
        'set screen mode
        Registers.AX = &H0
        CALL InterruptX(&H10, Registers, Registers)
        Registers.AX = &H3
        CALL InterruptX(&H10, Registers, Registers)
        STDOUT "Variable Dump" + CHR$(10) + CHR$(13) + CHR$(10)
        STDOUT "NewSeed&=" + LTRIM$(STR$(NewSeed&)) + Spaces$ + "TextPlasVariant=" + LTRIM$(STR$(TextPlasVariant)) + Spaces$ + "SinusLimit=" + LTRIM$(STR$(SinusLimit)) + CHR$(10) + CHR$(13)
        STDOUT "WAVESIDE1=" + LTRIM$(STR$(WAVESIDE1)) + Spaces$ + "WAVESIDE2=" + LTRIM$(STR$(WAVESIDE2)) + Spaces$ + "WAVESIDE3=" + LTRIM$(STR$(WAVESIDE3)) + CHR$(10) + CHR$(13)
        STDOUT "R1=" + LTRIM$(STR$(R1)) + Spaces$ + "R2=" + LTRIM$(STR$(R2)) + Spaces$ + "R3=" + LTRIM$(STR$(R3)) + CHR$(10) + CHR$(13)
        STDOUT "WAVE1=" + LTRIM$(STR$(WAVE1)) + Spaces$ + "WAVE2=" + LTRIM$(STR$(WAVE2)) + Spaces$ + "WAVE3=" + LTRIM$(STR$(WAVE3)) + CHR$(10) + CHR$(13)
        STDOUT "X=" + LTRIM$(STR$(X)) + Spaces$ + "Y=" + LTRIM$(STR$(Y)) + Spaces$ + "E=" + LTRIM$(STR$(E)) + CHR$(10) + CHR$(13)
        STDOUT "Position=" + LTRIM$(STR$(Position)) + Spaces$ + "Method=" + LTRIM$(STR$(Method)) + Spaces$ + "Color=" + LTRIM$(STR$(col)) + CHR$(10) + CHR$(13)
        STDOUT "ColoringMethod=" + LTRIM$(STR$(ColoringMethod)) + CHR$(10) + CHR$(13)
        END
    END IF

' Auto Reinit - prevent 'zero motion' side effect of sinus clipping
IF WAVESIDE1 = 0 AND WAVESIDE2 = 0 AND WAVESIDE3 = 0 AND WAVE1 = 0 AND WAVE2 = 0 AND WAVE3 = 0 THEN
   WAVESIDE1 = RND * 1: WAVE1 = RND * 1
   WAVESIDE2 = RND * 3: WAVE2 = RND * 3
   WAVESIDE3 = RND * 2: WAVE3 = RND * 2
   IF WAVESIDE1 = 0 AND WAVE1 = 0 THEN WAVESIDE1 = 1: WAVE1 = 1
   IF WAVESIDE2 = 0 AND WAVE2 = 0 THEN WAVESIDE2 = 1: WAVE2 = 1
   IF WAVESIDE3 = 0 AND WAVE3 = 0 THEN WAVESIDE3 = 1: WAVE3 = 1
END IF
LOOP
DEF SEG
STDOUT "TEXT PLASMA made by: Omega, omega@inorbit.com / Buzz, buzz@ddsw.nl" + CHR$(10) + CHR$(13)
STDOUT "Heavly modifided by: Zapf_DingBat@JUNO.COM" + CHR$(10) + CHR$(13)
END

SUB ColorSelect
SELECT CASE ColoringMethod
  CASE IS = 0
   R = (RND * 63): G = (RND * 63): B = (RND * 63)
    FOR I = 0 TO 15
     txtpalset I, I - R, I - G, I - B
    NEXT I
  CASE IS = 1
   R = (RND * 63): G = (RND * 63): B = (RND * 63)
    FOR I = 0 TO 6
     txtpalset I, I * R, I * G, I * B
    NEXT I
    FOR I = 7 TO 15
     txtpalset I, (15 - I) * R, (15 - I) * G, (15 - I) * B
    NEXT I
  CASE IS = 2
   R = (RND * 63): G = (RND * 63): B = (RND * 63)
    FOR I = 0 TO 6
     txtpalset I, (I / R) * 127, (I / G) * 127, (I / B) * 127
    NEXT I
    FOR I = 7 TO 15
     txtpalset I, ((15 - I) / R), ((15 - I) / G), ((15 - I) / B)
    NEXT I
  CASE IS = 3
   R = (RND * 63): G = (RND * 63): B = (RND * 63)
    FOR I = 0 TO 6
     txtpalset I, (I / R), (I / G), (I / B)
    NEXT I
    FOR I = 7 TO 15
     txtpalset I, ((15 - I) / R) * 127, ((15 - I) / G) * 127, ((15 - I) / B) * 127
    NEXT I
  CASE IS = 4
   R = (RND * 63): G = (RND * 63): B = (RND * 63)
    FOR I = 0 TO 6
     txtpalset I, (I / R) * 127, (I / G) * 127, (I / B) * 127
    NEXT I
    FOR I = 7 TO 15
     txtpalset I, ((15 - I) / R) * 127, ((15 - I) / G) * 127, ((15 - I) / B) * 127
    NEXT I
  CASE IS = 5
   R = (RND * 63): G = (RND * 63): B = (RND * 63)
    FOR I = 0 TO 15
     txtpalset I, INT(R + R2), INT(G + G2), INT(B + B2)
     R2 = (R + 1) * I ^ .11: G2 = (G + 1) * I ^ .22: B2 = (B + 1) * I ^ .33
    NEXT I
  CASE IS = 6
   R = (RND * 63): G = (RND * 63): B = (RND * 63)
    FOR I = 0 TO 15
     txtpalset I, INT(R + R2), INT(G + G2), INT(B + B2)
     R2 = (R + 1) * I ^ .22: G2 = (G + 1) * I ^ .33: B2 = (B + 1) * I ^ .11
    NEXT I
  CASE IS = 7
   R = (RND * 63): G = (RND * 63): B = (RND * 63)
    FOR I = 0 TO 15
     txtpalset I, INT(R + R2), INT(G + G2), INT(B + B2)
     R2 = (R + 1) * I ^ .33: G2 = (G + 1) * I ^ .11: B2 = (B + 1) * I ^ .22
    NEXT I
  CASE IS = 8
   R = (RND * 63): G = (RND * 63): B = (RND * 63)
    FOR I = 0 TO 15
     txtpalset I, INT(R + R2), INT(G + G2), INT(B + B2)
     R2 = ((R + 1 + I) * .11): G2 = ((G + 1 + I * .59)): B2 = ((B + 1 + I * .3))
    NEXT I
  CASE IS = 9 'GRAY 1
   R = (RND * 63): G = R: B = R
    FOR I = 0 TO 15
     txtpalset I, XC, XC, XC
     R2 = ((R + 1 + I) * .11): G2 = ((G + 1 + I * .59)): B2 = ((B + 1 + I * .3))
     XC = INT(R2 + G2 + B2)
    NEXT I
  CASE IS = 10 'GRAY 2
   R = (RND * 63): G = R: B = R
    FOR I = 0 TO 15
     txtpalset I, XC, XC, XC
     R2 = ((R + 1 + I) * .11) ^ 2: G2 = ((G + 1 + I * .59)): B2 = ((B + 1 + I * .3))
     XC = INT(R2 + G2 + B2)
    NEXT I
  CASE IS = 11 'GRAY 3
   R = (RND * 63): G = R: B = R
    FOR I = 0 TO 15
     txtpalset I, XC, XC, XC
     R2 = ((R + 1 + I) * .11): G2 = ((G + 1 + I * .59)) ^ 2: B2 = ((B + 1 + I * .3))
     XC = INT(R2 + G2 + B2)
    NEXT I
  CASE IS = 12 'GRAY 4
   R = (RND * 63): G = R: B = R
    FOR I = 0 TO 15
     txtpalset I, XC, XC, XC
     R2 = ((R + 1 + I) * .11): G2 = ((G + 1 + I * .59)): B2 = ((B + 1 + I * .3)) ^ 2
     XC = INT(R2 + G2 + B2)
    NEXT I
  CASE IS = 13
   R = (RND * 63): G = R: B = R
    FOR I = 0 TO 15
     txtpalset I, XC \ 2, XC \ 4, XC \ 8
     R2 = ((R + 1 + I) * .11): G2 = ((G + 1 + I * .59)): B2 = ((B + 1 + I * .3)) ^ 2
     XC = INT(R2 + G2 + B2)
    NEXT I
END SELECT
END SUB

SUB GenLookupTables
' compute look up tables
DO
SinusLimit = INT(RND * 80)  ' not make bigger than 80, it doesn't work !
LOOP UNTIL SinusLimit >= 30 'this is to prevent most visual distortion
FOR C = 0 TO 278
    ' We calculate these variants double precision
    SELECT CASE TextPlasVariant
     CASE IS = 0
      COSINUS#(C) = COS(C * 2 * PI / SinusLimit) * 16 + 16 'Original
     CASE IS = 1
      COSINUS#(C) = SIN(C * 2 * PI / SinusLimit) * 16 + 16 'Variant 1
     CASE IS = 2
      COSINUS#(C) = (SIN(C * 2 * PI / SinusLimit) * 16 + 16 + COS(C * 2 * PI / SinusLimit) * 16 + 16) \ 4 'Variant 2
     CASE IS = 3
      COSINUS#(C) = (SIN(C * 2 * PI / SinusLimit) * 16 + 16 - COS(C * 2 * PI / SinusLimit) * 16 + 16) \ 4 'Variant 3
     CASE IS = 4
      COSINUS#(C) = (SIN(C * 2 * PI / SinusLimit) * 16 + 16 * COS(C * 2 * PI / SinusLimit) * 16 + 16) \ 4 'Variant 4
     CASE IS = 5
      COSINUS#(C) = (SIN(C * 2 * PI / SinusLimit) * 4 / COS(C * 2 * PI / SinusLimit) * 4)   'Variant 5
     CASE IS = 6
      COSINUS#(C) = TAN(C * 2 * PI / SinusLimit) * 2  'Variant 6
     CASE IS = 7
      COSINUS#(C) = SIN(C * PI / SinusLimit) * 32 + 16 'Variant 7
     CASE IS = 8
      COSINUS#(C) = SIN(C * PI / SinusLimit) * 32 - 16 'Variant 8
     CASE IS = 9
      COSINUS#(C) = COS(C * PI / SinusLimit) * 32 + 16 'Variant 9
     CASE IS = 10
      COSINUS#(C) = COS(C * PI / SinusLimit) * 32 - 16 'Variant 10
    END SELECT
    ' clip values to within Short Integer ranges (2 bytes)
    ' limit to avaliable colors
    IF COSINUS#(C) < -32768 THEN COSINUS#(C) = -255
    IF COSINUS#(C) > 32767 THEN COSINUS#(C) = 255
    ' put result in to integer array
    COSINUSx(C) = INT(COSINUS#(C))
NEXT C

FOR C = 0 TO 278
    RAND(C) = INT(RND * 4) + 1
NEXT C
END SUB

SUB Help
STDOUT "TEXT PLASMA made by: Omega, omega@inorbit.com / Buzz, buzz@ddsw.nl" + CHR$(10) + CHR$(13)
STDOUT "Heavly modifided by: Zapf_DingBat@JUNO.COM" + CHR$(10) + CHR$(13) + CHR$(10)

STDOUT "Press G for new bit garbage." + CHR$(10) + CHR$(13)
STDOUT "Press I for a reversed palette." + CHR$(10) + CHR$(13)
STDOUT "Press N for a palette." + CHR$(10) + CHR$(13)
STDOUT "Press T for new a plasma table." + CHR$(10) + CHR$(13)
STDOUT "Press CTRL-Backspace to restart TEXT PLASMA." + CHR$(10) + CHR$(13)
STDOUT "Press ESC to exit." + CHR$(10) + CHR$(13) + CHR$(10)

STDOUT "L8tr kids !" + CHR$(10) + CHR$(13)
END
END SUB

SUB MakeGarbage
FOR StringAdd = 0 TO 511
Z$ = Z$ + CHR$(CINT(RND * 255))
NEXT StringAdd
Registers.AX = &H1100 'AX tells call DOS set font routine
Registers.BX = &H200  'BX tells DOS to store 08 lines per char and font bank 0
Registers.CX = &H100  'CX tells DOS to change all characters
Registers.DX = 0      'DX tells DOS which char to start from
' for PDS change VARSEG to SSEG
Registers.ES = VARSEG(Z$) ' ES tells DOS where the segment is
Registers.BP = SADD(Z$)   ' BP tells DOS where the address is
CALL InterruptX(&H10, Registers, Registers) ' call int 10 and make changes
Z$ = ""
DEF SEG = &HB800
FOR I = 0 TO 31998 STEP 2
     'POKE i, 32
     POKE I, CINT(RND * 255)
NEXT I
DEF SEG
END SUB

FUNCTION Monitor% (VSSegment)
DEF SEG = 0              'first see if it's color or mono
VSSegment = &HB800         'assume color

IF PEEK(&H463) = &HB4 THEN

  VSSegment = &HB000       'assign the monochrome segment
  Status = INP(&H3BA)    'get the current video status
  FOR X = 1 TO 30000     'test for a Hercules 30000 times
    IF INP(&H3BA) <> Status THEN
      Monitor% = 2       'the port changed, it's a Herc
      EXIT FUNCTION      'all done
    END IF
  NEXT
  Monitor% = 1           'it's a plain monochrome

ELSE                     'it's some sort of color monitor

  Registers.AX = &H1A00     'first test for VGA
  CALL InterruptX(&H10, Registers, Registers)
  IF (Registers.AX AND &HFF) = &H1A THEN
    Monitor% = 5         'it's a VGA
    EXIT FUNCTION        'all done
  END IF

  Registers.AX = &H1200     'now test for EGA
  Registers.BX = &H10
  CALL InterruptX(&H10, Registers, Registers)
  IF (Registers.BX AND &HFF) = &H10 THEN
    Monitor% = 3         'if BL is still &H10 it's a CGA
  ELSE
    Monitor% = 4         'otherwise it's an EGA
  END IF
END IF
DEF SEG
END FUNCTION

SUB STDOUT (MESSAGETEXT$)
'writes text to dos's standard output
Registers.AX = &H4000
Registers.BX = &H1
Registers.CX = LEN(MESSAGETEXT$)
' for PDS change VARSEG to SSEG
Registers.DS = VARSEG(MESSAGETEXT$)
Registers.DX = SADD(MESSAGETEXT$)
CALL InterruptX(&H21, Registers, Registers)
END SUB

SUB txtpalget (col, R, G, B)
C = col
SELECT CASE C
CASE 6
 C = 20
CASE 8 TO 15
 C = C + 48
END SELECT
OUT &H3C7, C: R = INP(&H3C9): G = INP(&H3C9): B = INP(&H3C9)
END SUB

SUB txtpalset (col, R, G, B)
C = col
SELECT CASE C
CASE 6
 C = 20
CASE 8 TO 15
 C = C + 48
END SELECT
OUT &H3C8, C: OUT &H3C9, R: OUT &H3C9, G: OUT &H3C9, B
END SUB