PROGRAM LISTING: 85-06/COLORS.ACT

; COLORS (LISTING 3)

MODULE:BYTE ARRAY dfault(5),CP
  ,C7=[52 24 130 194 0]
  ,C8=[52 26 0 194 208]
  ,CM=[52 24 194 130 80]
  
PROC IncC():BYTE i
i=cnow:cnow==+1:Position(10,23)
IF i=3 THEN i=4:cnow=0 FI
Kolor(cnow):i=clor(i):PrintB(cnow)
Position(18,23):PrintB(i RSH 4)
Put(' ):Position(27,23)
PrintB(i & 14):Put(' ):RETURN

PROC IncHue():BYTE i,j
IF cnow=0 THEN i=4 ELSE i=cnow-1 FI
j=clor(i) RSH 4
j==+1:IF j>15 THEN j=0 FI
Position(18,23):PrintB(j):Put(' )
clor(i)=(j LSH 4)+(clor(i) & 14)
C7(i)=clor(i):RETURN

PROC IncLum():BYTE i,j
IF cnow=0 THEN i=4 ELSE i=cnow-1 FI
j=clor(i) & 14
j==+2:IF j>15 THEN j=0 FI
Position(27,23):PrintB(j):Put(' )
clor(i)=(clor(i) & 240)+j
C7(i)=clor(i):RETURN

PROC DfaultC():BYTE i
FOR i=0 TO 4 DO C7(i)=dfault(i)
  clor(i)=C7(i)
OD RETURN

PROC SetDfault():BYTE i
FOR i=0 TO 4 DO dfault(i)=C7(i) OD:RETURN

PROC CPon():BYTE i
FOR i=0 TO 4 DO clor(i)=CP(i) OD:RETURN

PROC CMon():BYTE i
FOR i=0 TO 4 DO clor(i)=CM(i) OD:RETURN

PROC FixCol():IncC()
DO WHILE key=255 DO OD
  IF key=18 THEN key=255:IncC()
  ELSEIF key=57 THEN key=255:IncHue()
  ELSEIF key=0 THEN key=255:IncLum()
  ELSEIF key=58 THEN key=255:DfaultC()
  ELSE EXIT FI
OD RETURN