DECLARE FUNCTION Scan$ (Limit AS INTEGER, Inf AS INTEGER, Sup AS INTEGER, YYY AS INTEGER, XXX AS INTEGER, Colore AS INTEGER)
DECLARE SUB ModifyPalette (Col AS INTEGER)
DECLARE SUB SavePalette ()
DECLARE SUB WriteData (XXX AS INTEGER, YYY AS INTEGER, Activ AS INTEGER)

SCREEN 12
LINE (0, 0)-(639, 479), 9, B
LINE (122, 147)-(518, 362), 12, B
LOCATE 12, 29: PRINT "Palette VGA a 16 colori"
FOR Column% = 0 TO 1
   FOR Row% = 14 TO 21
      Item$ = MID$(STR$(Row% - 14 + Column% * 8), 2)
      LOCATE Row%, Column% * 17 + 20
      IF VAL(Item$) < 17 THEN
         READ Colour$
         COLOR VAL(Item$): PRINT STRING$(2 - LEN(Item$), 32) + Item$ + SPACE$(2) + Colour$
      END IF
   NEXT
NEXT
COLOR 15: LOCATE 2, 3: PRINT "VGA Palette Manipulator vers. 1.00 - Copyright (C) 1997 by Peter2000"
LOCATE 3, 3: PRINT "Numero del colore da modificare (0-255): ";
DO
   LOCATE 3, 44: PRINT SPACE$(3);
   Num$ = Scan$(3, 48, 57, 3, 44, 15)
   Col% = VAL(Num$)
LOOP UNTIL Col% < 256 AND LEN(Num$) <> 0
COLOR 14: LOCATE 5, 19: PRINT CHR$(27); SPACE$(41); CHR$(26)
LOCATE 6, 5: PRINT "Q"; SPACE$(24); "W"; SPACE$(24); "E"
LOCATE 7, 5: PRINT "A"; SPACE$(24); "S"; SPACE$(24); "D"
LOCATE 8, 21: PRINT "P"
COLOR 11: LOCATE 5, 20: PRINT "  Colore precedente   Colore successivo  "
LOCATE 6, 8: PRINT "Incrementa il rosso"
LOCATE 6, 33: PRINT "Incrementa il verde"
LOCATE 6, 58: PRINT "Incrementa il blu"
LOCATE 7, 8: PRINT "Decrementa il rosso"
LOCATE 7, 33: PRINT "Decrementa il verde"
LOCATE 7, 58: PRINT "Decrementa il blu"
LOCATE 8, 24: PRINT "Salva la palette corrente in un file"
COLOR 10: LOCATE 29, 3: PRINT "Premere X per uscire o R per resettare questo colore";
ModifyPalette Col%

DATA Nero, Blu, Verde, Azzurro, Rosso, Viola, Marrone, Bianco, Grigio, Blu luminescente
DATA Verde luminescente, Azzurro luminescente, Rosso luminescente, Viola luminescente, Giallo, Bianco luminescente

SUB ModifyPalette (Col AS INTEGER)

DIM Pal(0 TO 255, 1 TO 3) AS INTEGER
DIM Temp(1 TO 3) AS INTEGER
OUT &H3C7, 0
FOR I% = 0 TO 255
   FOR J% = 1 TO 3
      Pal%(I%, J%) = INP(&H3C9)
   NEXT
NEXT
FOR I% = 1 TO 3
   Temp%(I%) = Pal%(Col%, I%)
NEXT
GOSUB Routine

Start:
LINE (122, 390)-(253, 424), 4, B
LINE (255, 390)-(385, 424), 2, B
LINE (387, 390)-(518, 424), 1, B
COLOR 4: LOCATE 26, 22: PRINT "Rosso"
COLOR 2: LOCATE 26, 38: PRINT "Verde"
COLOR 1: LOCATE 26, 56: PRINT "Blu"
COLOR 15: LOCATE 13, 69: PRINT "Componenti"
COLOR 14: LOCATE 16, 73: PRINT "Rosso": LOCATE 17, 73: PRINT "Verde": LOCATE 18, 73: PRINT "Blu"
IF Col% > 15 THEN
   COLOR 15: LOCATE 13, 5: PRINT "Campione"
   LINE (32, 224)-(94, 286), 7, BF
END IF

Init:
IF Col% = 4 OR Col% = 2 OR Col% = 1 THEN
   OUT &H3C8, Col%
   FOR I% = 1 TO 3
      OUT &H3C9, Pal%(Col%, I%)
      Temp%(I%) = Pal%(Col%, I%)
      COLOR 14: LOCATE 16, 71 - LEN(STR$(Temp%(I%))): PRINT Temp%(I%)
   NEXT
END IF
COLOR 14: OUT &H3C7, Col%
FOR Index% = 1 TO 3
   Temp%(Index%) = INP(&H3C9)
   LOCATE 15 + Index%, 71 - LEN(STR$(Temp%(Index%))): PRINT Temp%(Index%)
NEXT
GOSUB Routine

Begin:
WriteData 29, 60, 13
Wait$ = UCASE$(INKEY$)
SELECT CASE Wait$
   CASE "Q":
      IF Temp%(1) < 63 THEN
         Temp%(1) = Temp%(1) + 1
         OUT &H3C8, 4
         OUT &H3C9, Temp%(1): OUT &H3C9, 0: OUT &H3C9, 0
         IF Col% > 15 THEN
            OUT &H3C8, 7
            OUT &H3C9, Temp%(1): OUT &H3C9, Temp%(2): OUT &H3C9, Temp%(3)
         END IF
         OUT &H3C8, Col%
         OUT &H3C9, Temp%(1): OUT &H3C9, Temp%(2): OUT &H3C9, Temp%(3)
         COLOR 14: LOCATE 16, 71 - LEN(STR$(Temp%(1))): PRINT Temp%(1)
      END IF
   CASE "A":
      IF Temp%(1) > 0 THEN
         Temp%(1) = Temp%(1) - 1
         OUT &H3C8, 4
         OUT &H3C9, Temp%(1): OUT &H3C9, 0: OUT &H3C9, 0
         IF Col% > 15 THEN
            OUT &H3C8, 7
            OUT &H3C9, Temp%(1): OUT &H3C9, Temp%(2): OUT &H3C9, Temp%(3)
         END IF
         OUT &H3C8, Col%
         OUT &H3C9, Temp%(1): OUT &H3C9, Temp%(2): OUT &H3C9, Temp%(3)
         COLOR 14: LOCATE 16, 71 - LEN(STR$(Temp%(1))): PRINT Temp%(1)
      END IF
   CASE "W":
      IF Temp%(2) < 63 THEN
         Temp%(2) = Temp%(2) + 1
         OUT &H3C8, 2
         OUT &H3C9, 0: OUT &H3C9, Temp%(2): OUT &H3C9, 0
         IF Col% > 15 THEN
            OUT &H3C8, 7
            OUT &H3C9, Temp%(1): OUT &H3C9, Temp%(2): OUT &H3C9, Temp%(3)
         END IF
         OUT &H3C8, Col%
         OUT &H3C9, Temp%(1): OUT &H3C9, Temp%(2): OUT &H3C9, Temp%(3)
         COLOR 14: LOCATE 17, 71 - LEN(STR$(Temp%(2))): PRINT Temp%(2)
      END IF
   CASE "S":
      IF Temp%(2) > 0 THEN
         Temp%(2) = Temp%(2) - 1
         OUT &H3C8, 2
         OUT &H3C9, 0: OUT &H3C9, Temp%(2): OUT &H3C9, 0
         IF Col% > 15 THEN
            OUT &H3C8, 7
            OUT &H3C9, Temp%(1): OUT &H3C9, Temp%(2): OUT &H3C9, Temp%(3)
         END IF
         OUT &H3C8, Col%
         OUT &H3C9, Temp%(1): OUT &H3C9, Temp%(2): OUT &H3C9, Temp%(3)
         COLOR 14: LOCATE 17, 71 - LEN(STR$(Temp%(2))): PRINT Temp%(2)
      END IF
   CASE "E":
      IF Temp%(3) < 63 THEN
         Temp%(3) = Temp%(3) + 1
         OUT &H3C8, 1
         OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, Temp%(3)
         IF Col% > 15 THEN
            OUT &H3C8, 7
            OUT &H3C9, Temp%(1): OUT &H3C9, Temp%(2): OUT &H3C9, Temp%(3)
         END IF
         OUT &H3C8, Col%
         OUT &H3C9, Temp%(1): OUT &H3C9, Temp%(2): OUT &H3C9, Temp%(3)
         COLOR 14: LOCATE 18, 71 - LEN(STR$(Temp%(3))): PRINT Temp%(3)
      END IF
   CASE "D":
      IF Temp%(3) > 0 THEN
         Temp%(3) = Temp%(3) - 1
         OUT &H3C8, 1
         OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, Temp%(3)
         IF Col% > 15 THEN
            OUT &H3C8, 7
            OUT &H3C9, Temp%(1): OUT &H3C9, Temp%(2): OUT &H3C9, Temp%(3)
         END IF
         OUT &H3C8, Col%
         OUT &H3C9, Temp%(1): OUT &H3C9, Temp%(2): OUT &H3C9, Temp%(3)
         COLOR 14: LOCATE 18, 71 - LEN(STR$(Temp%(3))): PRINT Temp%(3)
      END IF
   CASE MKI$(19200):
      IF Col% > 0 THEN
         Col% = Col% - 1
         COLOR 15: LOCATE 3, 43: PRINT Col%; SPACE$(2)
         IF Col% = 15 THEN
            LINE (32, 194)-(94, 286), 0, BF
            OUT &H3C8, 7
            FOR I% = 1 TO 3
               OUT &H3C9, Pal%(7, I%)
            NEXT
         END IF
         GOTO Init
      END IF
   CASE MKI$(19712):
      IF Col% < 255 THEN
         Col% = Col% + 1
         COLOR 15: LOCATE 3, 43: PRINT Col%; SPACE$(2)
         GOTO Start
      END IF
   CASE "P": SavePalette
   CASE "R":
      OUT &H3C8, Col%
      COLOR 14: FOR I% = 1 TO 3
         OUT &H3C9, Pal%(Col%, I%)
         LOCATE 15 + I%, 71 - LEN(STR$(Pal%(Col%, I%))): PRINT Pal%(Col%, I%)
      NEXT
      GOTO Init
   CASE "X":
      FOR I% = 1 TO 64
         FOR J% = 1 TO 30000: NEXT
         OUT &H3C7, 0
         FOR J% = 0 TO 255
            FOR K% = 1 TO 3
               Pal%(J%, K%) = INP(&H3C9)
               IF Pal%(J%, K%) > 0 THEN Pal%(J%, K%) = Pal%(J%, K%) - 1
            NEXT
         NEXT
         OUT &H3C8, 0
         FOR J% = 0 TO 255
            FOR K% = 1 TO 3
               OUT &H3C9, Pal%(J%, K%)
            NEXT
         NEXT
      NEXT
      EXIT SUB
END SELECT
GOTO Begin

Routine:
OUT &H3C8, 4
OUT &H3C9, Temp%(1): OUT &H3C9, 0: OUT &H3C9, 0
OUT &H3C8, 2
OUT &H3C9, 0: OUT &H3C9, Temp%(2): OUT &H3C9, 0
OUT &H3C8, 1
OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, Temp%(3)
IF Col% > 15 THEN
   OUT &H3C8, 7
   FOR Index% = 1 TO 3
      OUT &H3C9, Temp%(Index%)
   NEXT
END IF
RETURN

END SUB

SUB SavePalette

Palette$ = SPACE$(768)
OUT &H3C7, 0
FOR Index% = 1 TO 768
   MID$(Palette$, Index%, 1) = CHR$(INP(&H3C9))
NEXT
OPEN "Palette.Img" FOR OUTPUT AS #1
   PRINT #1, Palette$;
CLOSE

END SUB

FUNCTION Scan$ (Limit AS INTEGER, Inf AS INTEGER, Sup AS INTEGER, YYY AS INTEGER, XXX AS INTEGER, Colore AS INTEGER)

Limita:
Unit$ = ""
DO
Aspetta:
   LOCATE YYY%, XXX% + LEN(Unit$): COLOR Colore%: PRINT CHR$(95);
   DO
      Temp$ = INKEY$
      WriteData 29, 60, 13
   LOOP UNTIL Temp$ <> ""
   IF ASC(Temp$) = 27 THEN
      LOCATE YYY%, XXX%: PRINT SPACE$(Limit%);
      GOTO Limita
   END IF
   IF ASC(Temp$) = 8 AND LEN(Unit$) <> 0 THEN
      LOCATE YYY%, XXX% + LEN(Unit$) - 1: PRINT SPACE$(2);
      Cif% = LEN(Unit$) - 1
      IF Cif% > -1 THEN Unit$ = LEFT$(Unit$, Cif%)
   END IF
   IF (ASC(Temp$) < Inf% OR ASC(Temp$) > Sup%) AND ASC(Temp$) <> 13 THEN
      LOCATE YYY%, XXX% + LEN(Unit$): PRINT CHR$(32);
      GOTO Aspetta
   ELSE
      IF ASC(Temp$) <> 13 THEN
         LOCATE YYY%, XXX% + LEN(Unit$): COLOR Colore%: PRINT LCASE$(Temp$);
         Unit$ = Unit$ + Temp$
      ELSE
         LOCATE YYY%, XXX% + LEN(Unit$): PRINT CHR$(32);
         Scan$ = Unit$
         EXIT FUNCTION
      END IF
   END IF
LOOP UNTIL LEN(Unit$) = Limit%

Pazienta:
Invio$ = INKEY$
WriteData 29, 60, 13
IF Invio$ <> CHR$(13) THEN
   IF Invio$ = CHR$(27) THEN
      LOCATE YYY%, XXX%: PRINT SPACE$(Limite);
      GOTO Limita
   ELSE
      IF Invio$ = CHR$(8) THEN
         LOCATE YYY%, XXX% + LEN(Unit$) - 1: PRINT CHR$(32);
         Unit$ = LEFT$(Unit$, LEN(Unit$) - 1)
         GOTO Aspetta
      ELSE
         GOTO Pazienta
      END IF
   END IF
END IF
Scan$ = Unit$

END FUNCTION

SUB WriteData (XXX AS INTEGER, YYY AS INTEGER, Activ AS INTEGER)

COLOR Activ: LOCATE XXX, YYY: PRINT MID$(DATE$, 4, 3) + LEFT$(DATE$, 3) + RIGHT$(DATE$, 4) + CHR$(32) + TIME$;

END SUB