137 lines
2.3 KiB
ObjectPascal
137 lines
2.3 KiB
ObjectPascal
program viewpict;
|
|
const FadeDelay = 20;
|
|
FadeLevels = 15;
|
|
|
|
type PaletteData = array[0..15] of integer;
|
|
Palettes = array[1..FadeLevels] of PaletteData;
|
|
|
|
type PictData = record
|
|
magic, mode:integer;
|
|
palette: PaletteData;
|
|
pixeldata: array [0..31999] of integer;
|
|
end;
|
|
|
|
var pic:PictData;
|
|
filename:string;
|
|
infile:file;
|
|
ch:char;
|
|
|
|
procedure setBlackPalette;
|
|
var i:integer;
|
|
begin
|
|
for i := 0 to 15 do
|
|
setPalette(i, 0);
|
|
end;
|
|
|
|
procedure createFade(var pic:PictData;var fadedPalette: Palettes);
|
|
var i:integer;
|
|
c:integer;
|
|
rgb:integer;
|
|
r,g,b:integer;
|
|
|
|
procedure fade(var col:integer);
|
|
var delta:integer;
|
|
begin
|
|
|
|
delta := col * 10 div 100;
|
|
if delta < 1 then
|
|
delta := 1;
|
|
col := col - delta;
|
|
if col < 0 then
|
|
col := 0;
|
|
end;
|
|
|
|
begin
|
|
fadedPalette[1] := pic.palette;
|
|
|
|
for i := 2 to FadeLevels - 1 do
|
|
begin
|
|
for c := 0 to 15 do
|
|
begin
|
|
rgb := fadedPalette[i-1][c];
|
|
r := (rgb shr 8) and $F;
|
|
g := (rgb shr 4) and $F;
|
|
b := (rgb) and $F;
|
|
|
|
fade(r);
|
|
fade(g);
|
|
fade(b);
|
|
|
|
rgb := (r shl 8) or
|
|
(g shl 4) or
|
|
(b);
|
|
|
|
fadedPalette[i][c] := rgb;
|
|
end;
|
|
end;
|
|
|
|
for c := 0 to 15 do
|
|
fadedPalette[FadeLevels][c] := 0;
|
|
end;
|
|
|
|
procedure loadPalette(var p:PaletteData);
|
|
var i:integer;
|
|
begin
|
|
for i := 0 to 15 do
|
|
setpalette(i, p[i]);
|
|
end;
|
|
|
|
procedure loadPic(var pic:PictData);
|
|
begin
|
|
PutScreen(pic.pixeldata);
|
|
end;
|
|
|
|
procedure fadeIn(var pic:PictData);
|
|
var i:integer;
|
|
fadedPalette:Palettes;
|
|
begin
|
|
createFade(pic, fadedPalette);
|
|
for i := FadeLevels - 1 downto 1 do
|
|
begin
|
|
delay(FadeDelay);
|
|
loadPalette(fadedPalette[i]);
|
|
end
|
|
end;
|
|
|
|
procedure fadeOut(var pic:PictData);
|
|
var i:integer;
|
|
fadedPalette:Palettes;
|
|
begin
|
|
createFade(pic, fadedPalette);
|
|
for i := 1 to FadeLevels do
|
|
begin
|
|
delay(FadeDelay);
|
|
loadPalette(fadedPalette[i]);
|
|
end
|
|
end;
|
|
|
|
begin
|
|
if ParamCount > 0 then
|
|
filename := ParamStr(1)
|
|
else
|
|
begin
|
|
write('Filename> ');
|
|
readln(filename);
|
|
end;
|
|
|
|
open(infile, filename, ModeReadonly);
|
|
read(infile, pic);
|
|
close(infile);
|
|
|
|
writeln('magic: ', pic.magic, ' mode:', pic.mode);
|
|
|
|
initgraphics;
|
|
|
|
setBlackPalette;
|
|
loadPic(pic);
|
|
fadeIn(pic);
|
|
|
|
read(ch);
|
|
|
|
if ch <> 'k' then
|
|
begin
|
|
fadeOut(pic);
|
|
initgraphics;
|
|
end;
|
|
|
|
end.
|