DECLARE SUB paletteGet (array() AS INTEGER) DECLARE SUB paletteSet (array() AS INTEGER, duration AS SINGLE) DECLARE SUB paletteLoad (filename AS STRING, array() AS INTEGER) DECLARE SUB paletteSave (filename AS STRING, array() AS INTEGER) DECLARE SUB toneGrayscale (array() AS INTEGER) DECLARE SUB toneInvert (array() AS INTEGER) DECLARE SUB toneSepia (array() AS INTEGER) DECLARE SUB colorGet (attr AS INTEGER, r AS INTEGER, g AS INTEGER, b AS INTEGER) DECLARE SUB colorSet (attr AS INTEGER, r AS INTEGER, g AS INTEGER, b AS INTEGER) CONST DAC.PELMask = &H3C6 ' DAC (Digital/Analog Converter) PEL Mask Register CONST DAC.READ = &H3C7 ' DAC Read Port/DAC State Register CONST DAC.WRITE = &H3C8 ' DAC Write Port/DAC State Register CONST DAC.DATA = &H3C9 ' DAC Data Port OUT DAC.PELMask, &HFF ' Mask all registers for read/write DAC operations ' {attr} is the color attribute index, must be 0 - 255 ' {r}, {g} and {b} are filled with {attr}'s red green and blue components SUB colorGet (attr AS INTEGER, r AS INTEGER, g AS INTEGER, b AS INTEGER) OUT DAC.READ, attr ' Select attribute r = INP(DAC.DATA) ' Read red intensity g = INP(DAC.DATA) ' Read green intensity b = INP(DAC.DATA) ' Read blue intensity END SUB ' {attr} is the color attribute index, must be 0 - 255 ' {r}, {g} and {b} are red, green and blue intensity, must be 0 - 63 SUB colorSet (attr AS INTEGER, r AS INTEGER, g AS INTEGER, b AS INTEGER) OUT DAC.WRITE, attr ' Select attribute OUT DAC.DATA, r ' Feed red intensity OUT DAC.DATA, g ' Feed green intensity OUT DAC.DATA, b ' Feed blue intensity END SUB ' Read original palette, {array} is an INTEGER array ranging from (0 to 767) SUB paletteGet (array() AS INTEGER) OUT DAC.READ, 0 ' Select first attribute FOR i% = 0 TO 767 ' Read all 768 components array(i%) = INP(DAC.DATA) NEXT i% END SUB ' load {filename}, store content in {array}, {array} is an INTEGER array ranging from (0 to 767) SUB paletteLoad (filename AS STRING, array() AS INTEGER) DIM ff AS INTEGER DIM clr AS STRING * 768 ' open file (read) ff = FREEFILE OPEN filename FOR BINARY AS #ff GET #ff, , clr CLOSE #ff ' convert string to integer array FOR i% = 0 TO 767 array(i%) = ASC(MID$(clr, i% + 1, 1)) NEXT i% END SUB ' save content in {array} to {filename}, {array} is an INTEGER array ranging from (0 to 767) SUB paletteSave (filename AS STRING, array() AS INTEGER) DIM ff AS INTEGER DIM clr AS STRING * 768 ' convert integer array to string FOR i% = 0 TO 767 MID$(clr, i% + 1, 1) = CHR$(array(i%)) NEXT i% ' open file (write) ff = FREEFILE OPEN filename FOR BINARY AS #ff PUT #ff, , clr CLOSE #ff END SUB ' Set/transition to another palette, {target} is an INTEGER array ranging from (0 to 767) ' If {duration} is 0, change is instantaneous, transition otherwise SUB paletteSet (target() AS INTEGER, duration AS SINGLE) DIM source(0 TO 767) AS INTEGER DIM starts AS SINGLE, grad AS SINGLE IF (duration) THEN paletteGet source() ' Capture current palette FOR i% = 0 TO 767 ' and compute difference target(i%) = target(i%) - source(i%) ' (delta) between source NEXT i% ' and target. starts = TIMER ' Get current time OUT DAC.WRITE, 0 ' Select first attribute DO grad = (TIMER - starts) / duration ' Change for this frame IF (grad > 1) THEN grad = 1 ' Cap change FOR i% = 0 TO 767 OUT &H3C9, source(i%) + (target(i%) * grad) NEXT i% LOOP WHILE (grad < 1) ELSE OUT DAC.WRITE, 0 ' Select first attribute FOR i% = 0 TO 767 ' Set all 768 components OUT DAC.DATA, array(i%) NEXT i% END IF END SUB ' Convert palette to grayscale, {array} is an INTEGER array ranging from (0 to 767) SUB toneGrayscale (array() AS INTEGER) DIM gray AS INTEGER FOR i% = 0 TO 767 STEP 3 gray = array(i%) * .299 + array(i% + 1) * .587 + array(i% + 2) * .114 array(i%) = gray array(i% + 1) = gray array(i% + 2) = graygray NEXT i% END SUB ' Invert palette colors, {array} is an INTEGER array ranging from (0 to 767) SUB toneInvert (array() AS INTEGER) FOR i% = 0 TO 767 array(i%) = 63 - array(i%) NEXT i% END SUB ' Convert palette to sepia, {array} is an INTEGER array ranging from (0 to 767) SUB toneSepia (array() AS INTEGER) DIM r AS INTEGER, g AS INTEGER, b AS INTEGER FOR i% = 0 TO 767 STEP 3 r = array(i%) * .393 + array(i% + 1) * .769 + array(i% + 2) * .189 g = array(i%) * .349 + array(i% + 1) * .686 + array(i% + 2) * .168 b = array(i%) * .272 + array(i% + 1) * .534 + array(i% + 2) * .131 IF (r > 63) THEN array(i%) = 63 ELSE array(i%) = r IF (g > 63) THEN array(i% + 1) = 63 ELSE array(i% + 1) = g IF (b > 63) THEN array(i% + 2) = 63 ELSE array(i% + 2) = b NEXT i% END SUB