MAGAZINE\PALSYS.BAS  ·  BAS  ·  2.9 KB  ·  1991-07-01  ·  from PCPlus_Issue-58_Jul-1991
DEFINT A-Z
'$INCLUDE: 'qb.bi'
ON ERROR GOTO hand
IF COMMAND$ <> "" THEN GOTO nloadpal
DIM dave AS regtype
CLS
GOSUB usage
LOCATE 3, 1
FOR p = 0 TO 15: COLOR p: LOCATE p + 3, 7: PRINT STRING$(9, CHR$(219)); : PRINT : NEXT
col = 3: oldcol = 4
DO WHILE 1
	dave.ax = &H1007
	dave.bx = col - 3
	CALL interrupt(&H10, dave, dave)
	dacreg = dave.bx / 256
	dave.ax = &H1015
	dave.bx = dacreg
	CALL interrupt(&H10, dave, dave)
	r = (dave.dx / 256): g = (dave.cx / 256): b = (dave.cx AND 255)
	LOCATE col, 6: PRINT CHR$(26): LOCATE col, 16: PRINT CHR$(27)
	LOCATE oldcol, 6: PRINT CHR$(32): LOCATE oldcol, 16: PRINT CHR$(32)
	oldcol = col
	DO WHILE oldcol = col
		LOCATE 4, 40: COLOR 15: PRINT "Colour ="; col - 3;
		PRINT " R ="; r; " G ="; g; " B ="; b; "  ";
		g$ = INPUT$(1): g$ = LCASE$(g$)
		IF g$ = "8" THEN col = col - 1 ELSE IF g$ = "2" THEN col = col + 1
		IF g$ = "7" THEN r = r - 1 ELSE IF g$ = "9" THEN r = r + 1
		IF g$ = "4" THEN g = g - 1 ELSE IF g$ = "6" THEN g = g + 1
		IF g$ = "1" THEN b = b - 1 ELSE IF g$ = "3" THEN b = b + 1
		IF g$ = "s" THEN GOSUB savepal
		IF g$ = "l" THEN GOSUB loadpal
		IF g$ = "q" THEN
			dave.ax = &H4C00
			CALL interrupt(&H21, dave, dave)
		END IF
		IF r > 63 THEN r = 63 ELSE IF r < 0 THEN r = 0
		IF g > 63 THEN g = 63 ELSE IF g < 0 THEN g = 0
		IF b > 63 THEN b = 63 ELSE IF b < 0 THEN b = 0
		IF col < 3 THEN col = 3 ELSE IF col > 18 THEN col = 18
		dave.ax = &H1010
		dave.bx = dacreg
		dave.dx = r * 256
		dave.cx = (256 * g) + b
		CALL interrupt(&H10, dave, dave)
		g$ = ""
	LOOP
LOOP

loadpal:
LOCATE 6, 40: INPUT "Filename : ", a$
LOCATE 6, 40: PRINT SPACE$(39);
LOCATE 6, 40: PRINT "Loading palette...";
OPEN "I", 1, a$
FOR c = 0 TO 15
INPUT #1, r, g, b
dave.ax = &H1007: dave.bx = c
CALL interrupt(&H10, dave, dave)
dacreg = dave.bx / 256: dave.ax = &H1010: dave.bx = dacreg
dave.dx = r * 256: dave.cx = (256 * g) + b
CALL interrupt(&H10, dave, dave)
NEXT
CLOSE #1
LOCATE 6, 40: PRINT SPACE$(39);
RETURN

savepal:
LOCATE 6, 40: INPUT "Filename : ", a$
LOCATE 6, 40: PRINT SPACE$(39);
LOCATE 6, 40: PRINT "Saving palette...";
OPEN "O", 1, a$
FOR c = 0 TO 15
dave.ax = &H1007: dave.bx = c
CALL interrupt(&H10, dave, dave)
dacreg = dave.bx / 256: dave.ax = &H1015: dave.bx = dacreg
CALL interrupt(&H10, dave, dave)
r = (dave.dx / 256): g = (dave.cx / 256): b = (dave.cx AND 255)
PRINT #1, r, g, b
NEXT
CLOSE #1
LOCATE 6, 40: PRINT SPACE$(39);
RETURN

usage:
COLOR 15
LOCATE 8, 40: PRINT "7 - Lose Red     9 - Gain Red"
LOCATE 9, 40: PRINT "4 - Lose Green   6 - Gan  Green"
LOCATE 10, 40: PRINT "1 - Lose Blue    3 - Gain Blue"
LOCATE 12, 40: PRINT "8 - Move up      2 - Move Down"
LOCATE 13, 40: PRINT "L - Load Palette S - Save Palette"
LOCATE 14, 40: PRINT "Q - Quit to DOS"
LOCATE 17, 40: PRINT "Written by D. Patient 1991"
RETURN


hand:
PRINT "An error has occured."
ERROR ERR
END

nloadpal:
GOSUB loadpal
dave.ax = &H4C00
CALL interrupt(&H21, dave, dave)