{
  A nice little collection of palette manipulation :)

  Note: Make sure you always call savePal() before you do *any*
        manipulation of the palette, cause if you dont then yer
        palette is lost! and to restore the palette once its been
        saved and to unfade with steps use unFade()

        So to do the nifty white fade in/out i did for DefJamz:
         ..
         savePal;
         fadeWhite;
         ( display screen here )
         unFade;
         ..
}
unit skapal;
     interface uses crt,dos;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure setPal(col,r,g,b : byte);
procedure getPal(col : byte; Var r,g,b : byte);
procedure savepal;
procedure restorepal;
procedure fadeDown;
procedure fadeWhite;
procedure unFade;
procedure blackOut;
procedure cls(size:word);
procedure waitRetrace;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
implementation
var pall2 : array[0..63,1..3] of byte;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure setPal(col,r,g,b : byte); assembler;
asm
  mov    dx,3c8h
  mov    al,[col]
  out    dx,al
  inc    dx
  mov    al,[r]
  out    dx,al
  mov    al,[g]
  out    dx,al
  mov    al,[b]
  out    dx,al
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure getPal(col : byte; Var r,g,b : byte);
var
   rr,gg,bb : byte;
begin
  asm
    mov    dx,3c7h
    mov    al,col
    out    dx,al

    add    dx,2

    in     al,dx
    mov    [rr],al
    in     al,dx
    mov    [gg],al
    in     al,dx
    mov    [bb],al
  end;
  r := rr;
  g := gg;
  b := bb;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure savepal;
var loop1:integer;
begin
  for loop1 := 0 to 63 do
    getPal(loop1,pall2[loop1,1],pall2[loop1,2],pall2[loop1,3]);
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure restorepal;
var loop1:integer;
begin
  waitRetrace;
  for loop1 := 0 to 63 do
    setPal(loop1,pall2[loop1,1],pall2[loop1,2],pall2[loop1,3]);
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure fadeDown;
var loop1,loop2 : byte;
    Tmp : Array [1..3] of byte;
begin
  for loop1 := 1 to 64 do begin
    waitRetrace;
    for loop2 := 0 to 63 do begin
      getpal (loop2,Tmp[1],Tmp[2],Tmp[3]);
      if Tmp[1]>0 then dec (Tmp[1],round(tmp[1]/(64-loop1)+1));
      if Tmp[2]>0 then dec (Tmp[2],round(tmp[2]/(64-loop1)+1));
      if Tmp[3]>0 then dec (Tmp[3],round(tmp[3]/(64-loop1)+1));
      setPal (loop2,Tmp[1],Tmp[2],Tmp[3]);
    end;
  end;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure fadeWhite;
var loop1,loop2 : byte;
    tmp : Array [1..3] of byte;
begin
  for loop1 := 1 to 64 do begin
    WaitRetrace;
    for loop2 := 0 to 63 do begin
      getpal (loop2,Tmp[1],Tmp[2],Tmp[3]);
      if Tmp[1]<63 then inc (Tmp[1]);
      if Tmp[2]<63 then inc (Tmp[2]);
      if Tmp[3]<63 then inc (Tmp[3]);
      setPal (loop2,Tmp[1],Tmp[2],Tmp[3]);
    end;
  end;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure unFade;
var loop1,loop2 : byte;
    tmp : Array [1..3] of byte;
begin
  for loop1 := 1 to 64 do begin
    waitRetrace;
    for loop2 := 0 to 63 do begin
      Getpal (loop2,Tmp[1],Tmp[2],Tmp[3]);
      if Tmp[1]<Pall2[loop2,1] then inc (Tmp[1]);
      if Tmp[1]>Pall2[loop2,1] then dec (Tmp[1]);
      if Tmp[2]<Pall2[loop2,2] then inc (Tmp[2]);
      if Tmp[2]>Pall2[loop2,2] then dec (Tmp[2]);
      if Tmp[3]<Pall2[loop2,3] then inc (Tmp[3]);
      if Tmp[3]>Pall2[loop2,3] then dec (Tmp[3]);
      SetPal (loop2,Tmp[1],Tmp[2],Tmp[3]);
    end;
  end;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure blackOut;
var
  loop:byte;
begin
  for loop:=0 to 63 do setPal(loop,0,0,0);
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure cls(size:word);
begin
  fillChar(mem[$b800:0],size,0);
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure waitRetrace; assembler;
asm
    mov dx,3DAh
@@11:
    in  al,dx
    and al,08h
    jnz @@11
@@12:
    in  al,dx

    and al,08h
    jz  @@12
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
end.