{
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.