{ SETPAL.INC by Kari Lammassaari / Finland }

Type PaletteArrayType = Array[0..15,0..2] Of Byte;

Const OriginalPalette :PaletteArrayType =
                                        ( (0,0,0), (0,0,0), (1,6,1), (3,7,3),
                                          (1,1,7), (2,3,7), (5,1,1), (2,6,7),
                                          (7,1,1), (7,3,3), (6,6,1), (6,6,4),
                                          (1,4,1), (6,2,5), (5,5,5), (7,7,7)
                                         );
Var PaletteArray :PaletteArrayType;

Procedure SetPal(Var PalAr:PaletteArrayType);

  Var temp           :^Byte;
      temp2          :Integer;
      PaletteAddress :Integer;
      ScrMod         :Byte Absolute $fcaf;
      LinLen         :Byte Absolute $f3b0;
      AddrHi,AddrLo,
      AddrMid         :Byte;

  Begin
   GetMem(temp,32);
   temp2 := Addr(PalAr);

   Inline( {Write data to VDP. }
           $DD/$2A/ temp2 /$ED/$5B/ temp  /$06/$10/$DD/$4E/$00/$CB/$21/$CB/

           $21/$CB/$21/$CB/$21/$DD/$7E/$02/$E6/$0F/$B1/$12/$13/$DD/$7E/$01/

           $12/$13/$DD/$23/$DD/$23/$DD/$23/$10/$E0/

           $F3/$3E/$00/$D3/$99/$3E/$10/$F6/$80/$D3/$99/
           $06/$20/$0E/$9A/$2a/ temp  /$ed/$b3/$fb
         );

   If ScrMod < 5 Then          {Chgmod does NOT create pal image with
                                screens 0-4 ! }
         Begin
          Case ScrMod Of
            0   :PaletteAddress := $0f00;
            1,3 :PaletteAddress := $2020;
            2,4 :PaletteAddress := $1b80;
          End ; {Case}

          If (ScrMod = 0) And (LinLen < 41) Then PaletteAddress := $0400;

          AddrHi := Hi(PaletteAddress) Div $40;
          AddrLo := Lo(PaletteAddress);
          AddrMid := Hi(PaletteAddress) And 63 ;

          Inline (
           {Create palette image to VRAM.}
           $F3/$3e/0  /$D3/$99/$3E/$2D/$F6/$80/$D3/$99/$3A/ AddrHi /$D3/

           $99/$3E/$0E/$F6/$80/$D3/$99/$3A/ AddrLo /$00/$D3/$99/$3A/ AddrMid /$F6/

           $40/$D3/$99/$2A/ temp /$01/$20/$00 /$7E/$D3/$98/$23/$0B/$79/

           $B0/$20/$F7/ $F3/$3e/ 0  /$D3/$99/$3E/$2D/$F6/$80/$D3/$99/
           $fb
                 );
        End ;{If}
    FreeMem(temp,32);

   End; {SetPal}


Procedure GetPal(Var PalAr:PaletteArrayType);

 Const Width40PalTable = $0400;
       Width80PalTable = $0f00;

       PaletteTable :Array[0..8] Of Integer = ( $0f00,
                                                $2020, $1b80, $2020, $1b80,
                                                $7680, $7680, $fa80, $fa80
                                              );  { For screens 0 - 8 }

 Var VramPal                 :Integer;  {Address of palette table in vram. }
     AddrHi, AddrMid, AddrLo :Byte;
     temp                    :^Byte;
     ScrMod                  :Byte Absolute $fcaf;
     LinLen                  :Byte Absolute $f3b0;
     temp2                   :Integer;

  Begin
     VramPal := PaletteTable[ScrMod];

     If (ScrMod = 0) And ( LinLen < 41) Then VramPal :=  $0400; {Msx1 txt scr}

     AddrHi := Hi(VramPal) Div $40;
     AddrLo := Lo(VramPal);
     AddrMid := Hi(VramPal) And 63 ;

     GetMem(temp,32) ; {Size of pallette table in Vram }
     temp2 := Addr(PalAr);

     Inline(

      {Get palette table from VRAM.}
      $F3/$3e/ 0  /$D3/$99/$3E/$2D/$F6/$80/$D3/$99/$3A/ AddrHi /$D3/

      $99/$3E/$0E/$F6/$80/$D3/$99/$3A/ AddrLo /$D3/$99/$3A/ AddrMid /$F6/

      $00/$D3/$99/$ED/$5B/ temp /$01/$20/$00 /$DB/$98/$12/$13/$0B/

      $79/$B0/$20/$F7/$3E/ 0 /$D3/$99/$3E/$2D/$F6/$80/$D3/$99/

      {Convert palette table to palette array.}

      $2A/ temp /$DD/$2A/ temp2 /$06/$10/$7E/$F5/$E6/$0F/$DD/$77/$02/

      $F1/$CB/$3F/$CB/$3F/$CB/$3F/$CB/$3F/$DD/$77/$00/$23/$7E/$DD/$77/

      $01/$23/$DD/$23/$DD/$23/$DD/$23/$10/$DF/$fb
      );
    Freemem(temp,32);
 End;  {GetPal}

Procedure ResetPal; {Restore original palette values to VDP.}

  Const OrigPalette :Array[0..15,0..2] Of Byte  =
                    ( (0,0,0), (0,0,0), (1,6,1), (3,7,3),
                      (1,1,7), (2,3,7), (5,1,1), (2,6,7),
                      (7,1,1), (7,3,3), (6,6,1), (6,6,4),
                      (1,4,1), (6,2,5), (5,5,5), (7,7,7)
                    );

  Var temp      :^Byte;
      temp2     :Integer;

  Begin
   temp2 := Addr(OrigPalette);
   GetMem(temp,32);

   Inline( $DD/$2A/ temp2 /$ED/$5B/ temp  /$06/$10/$DD/$4E/$00/$CB/$21/$CB/

           $21/$CB/$21/$CB/$21/$DD/$7E/$02/$E6/$0F/$B1/$12/$13/$DD/$7E/$01/

           $12/$13/$DD/$23/$DD/$23/$DD/$23/$10/$E0/

           $F3/$3E/$00/$D3/$99/$3E/$10/$F6/$80/$D3/$99/
           $06/$20/$0E/$9A/$2a/ temp  /$ed/$b3/
           $fb
         );
   FreeMem(temp,32);

  End; {ResetPal}

Procedure SetRGB(Color,r,g,b:Byte);
 Var rb,gr,colour :Byte;
 Begin
   rb := r*16+b;
   gr := g;
   Colour := color;
   Inline (
           $F3/$3A/colour /$D3/$99/$3E/$10/$F6/$80/$D3/$99/$3A/ rb /
           $D3/$9A/$3A/ gr /$D3/$9A/$FB
          );
 End;  {SetRgb}

Procedure FadeDown(Color,Speed:Byte);
				 { Fades color  r,g,b values to 0,0,0 =Black }
                                 { For security reasons SetPal must have been 
				   called before usage of this procedure 
				   in screens 0 - 4 }

  Var r,g,b :Byte;

  Begin
    GetPal(PaletteArray);
    r := PaletteArray[Color,0];
    g := PaletteArray[Color,1];
    b := PaletteArray[Color,2];
    Repeat 
      If r <> 0 then r:= r - 1;
      If g <> 0 then g:= g - 1;
      If b <> 0 then b:= b - 1;
      Delay(speed * 10 + 1);
      SetRGB(Color,r,g,b);
    Until (r=0) And (g=0) And (b=0);
  End; {FadeDown}

Procedure FadeUp(Color,Speed:Byte);
				 { Fades color  r,g,b values to 7,7,7 = white }
                                 { For security reasons SetPal must have been 
				   called before usage of this procedure 
				   in screens 0 - 4 }

  Var r,g,b :Byte;

  Begin
    GetPal(PaletteArray);
    r := PaletteArray[Color,0];
    g := PaletteArray[Color,1];
    b := PaletteArray[Color,2];
    Repeat 
      If r <> 7 then r:= r + 1;
      If g <> 7 then g:= g + 1;
      If b <> 7 then b:= b + 1;
      SetRGB(Color,r,g,b);
      Delay(speed * 10 + 1);
    Until (r=7) And (g=7) And (b=7);
  End; {FadeUp }

Procedure FadeTo(SourceColor,TargetColor,Speed:Byte);
				 { Fades source r,g,b values to rgb of target }
                                 { For security reasons SetPal must have been 
				   called before usage of this procedure 
				   in screens 0 - 4 }

  Var sr,sg,sb :Byte;
      tr,tg,tb :Byte;
  Begin
    GetPal(PaletteArray);
    sr := PaletteArray[SourceColor,0];
    sg := PaletteArray[SourceColor,1];
    sb := PaletteArray[SourceColor,2];

    tr := PaletteArray[TargetColor,0];
    tg := PaletteArray[TargetColor,1];
    tb := PaletteArray[TargetColor,2];

    Repeat 
      If sr <> tr then If sr < tr Then sr:= sr + 1 Else sr:=sr-1;
      If sg <> tg then If sg < tg Then sg:= sg + 1 Else sg:=sg-1;
      If sb <> tb then If sb < tb Then sb:= sb + 1 Else sb:=sb-1;

      SetRGB(SourceColor,sr,sg,sb);
      Delay(speed * 10 + 1);
    Until (sr=tr) And (sg=tg) And (sb=tb);

    PaletteArray[SourceColor,0] := sr;
    PaletteArray[SourceColor,1] := sg;
    PaletteArray[SourceColor,2] := sb;
    SetPal(PaletteArray);
  End; {FadeTo }