$if 0
PURPOSE:
  The routines in this document can be used to set/change the color
  values in the DAC registers. The number of registers varies from
  screen mode to screen mode but, for the testing purposes here, I
  refer to SCREEN 12 (color VGA) which can access 16 of 64 registers.

  Palete, fPalete&, and fRGB& have been created to allow easy conversion
  of MSbasic code that uses LONG integers to change the value of the DAC
  registers.
CONTENTS:
  DACset    sets one DAC register using R, G, and B elements
  DACget    reads/returns one DAC register using R, G, B elements
 fDACread$  returns a number of DAC registers into a string
  DACwrite  writes a number of DAC registers from a string
  Palete    sets one DAC register using a LONG integer like MS BASICs
 fPalete&   returns one DAC register in a LONG integer like MS BASICs
 fRGB&      returns a LONG integer using the R, G, B elements
VARIABLES:
  Red%      ¿ individual elements of the RGB color values
  Green%    Ã legal values are from 0 to 63
  Blue%     Ù
  Colour%   the DAC color number (or register)
  Colours%  the number of colors (registers) to be accessed
  DAC$      a string of DAC triplets "RGBRGBRGBRGB...."
NOTE:
  The code here has been written in such a way that it is compatible
  with both PowerBASIC and FirstBASIC.

  If your program will be making changes to the DAC it would be best if
  you store the original values in a string then restore them when your
  program terminates. Failure to do so would leave the system with the
  values you used and that may NOT be preferable.
  SEE: fDACread$ and DACwrite

Don

$endif
'========================================================================
'============== DEMO CODE ===============================================
'========================================================================
OldDAC$ = fDACread$( 64 )             ' save original values
CLS                                   '
COLOR 8, 0                            ' color 8 = DAC register 56
PRINT "HELLO WORLD"                   ' print test string
DELAY 2                               '
Red% = 63 : Green% = 63 : Blue% = 0   ' high yellow
RGB& = fRGB&( Red%, Green%, Blue% )   ' compute LONG integer
CALL Palete( 56, RGB& )               ' change DAC 56 to high yellow
DELAY 2                               '
CALL DACset( 56, 40, 0, 63 )          ' change DAC 56 to purple
DELAY 2                               '
CALL DACwrite( OldDAC$ )              ' restore original values
COLOR 7, 0 : PRINT "ALL DONE"         '
END                                   ' end of program
'========================================================================
'============== ROUTINES ================================================
'========================================================================

SUB DACget( BYVAL Colour%, BYVAL Red%, BYVAL Green%, BYVAL Blue% ) LOCAL PUBLIC

  OUT &h03C7, Colour%
  Red%   = INP( &h03C9 )
  Green% = INP( &h03C9 )
  Blue%  = INP( &h03C9 )

END SUB

' ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ

SUB DACset( BYVAL Colour%, BYVAL Red%, BYVAL Green%, BYVAL Blue% ) LOCAL PUBLIC

  OUT &h03C8, Colour%
  OUT &h03C9, Red%
  OUT &h03C9, Green%
  OUT &h03C9, Blue%

END SUB

' ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ

FUNCTION fDACread$( BYVAL Colours% ) LOCAL PUBLIC
  LOCAL DAC$

  DAC$ = STRING$( Colours% * 3, 0 ) ' create a buffer for the data
  REG 1, &h1017
  REG 2, 0
  REG 3, Colours%
  REG 4, STRPTR( DAC$ )
  REG 9, STRSEG( DAC$ )
  CALL INTERRUPT &h10

  fDACread$ = DAC$

END FUNCTION

' ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ

SUB DACwrite( SEG DAC$ ) LOCAL PUBLIC
  LOCAL Colours%

  Colours% = LEN( DAC$ ) \ 3
  REG 1, &h1012
  REG 2, 0
  REG 3, Colours%
  REG 4, STRPTR( DAC$ )
  REG 9, STRSEG( DAC$ )
  CALL INTERRUPT &h10

END SUB

' ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ

SUB Palete( BYVAL Colour%, BYVAL RGB& ) LOCAL PUBLIC
  LOCAL Red%, Green%, Blue%

  Red%   = ( RGB& MOD 256 ) : RGB& = RGB& \ 256
  Green% = ( RGB& MOD 256 )
  Blue%  = ( RGB&  \  256 )
  OUT &h03C8, Colour%
  OUT &h03C9, Red%
  OUT &h03C9, Green%
  OUT &h03C9, Blue%

END SUB

' ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ

FUNCTION fPalete&( BYVAL Colour% ) LOCAL PUBLIC
  LOCAL Red%, Green%, Blue%

  OUT &h03C7, Colour%
  Red%   = INP( &h03C9 )
  Green% = INP( &h03C9 )
  Blue%  = INP( &h03C9 )

  fPalete& = Red% + ( Green% * 256 ) + ( Blue% * 65536 )

END FUNCTION

' ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ

FUNCTION fRGB&( BYVAL Red%, BYVAL Green%, BYVAL Blue% ) LOCAL PUBLIC

  fRGB& = Red% + ( Green% * 256 ) + ( Blue% * 65536 )

END FUNCTION