slederer/Tridora-CPU
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages 3 Wiki Activity Actions

Revert last change to examples/viewpict

Browse source 
This reverts commit 896fd8937b.
This commit is contained in:
slederer 2025-02-09 00:01:01 +01:00
parent c2613bbc52
commit 9177f29308
1 changed files with 5 additions and 98 deletions
Download patch file Download diff file Expand all files Collapse all files

103
examples/viewpict.pas
View file

@ -1,79 +1,21 @@
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;
palette: array [0..15] of integer;
pixeldata: array [0..31999] of integer;
end;
var pic:PictData;
filename:string;
infile:file;
ch:char;
procedure setBlackPalette;
procedure loadPalette(var pic:PictData);
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]);
setpalette(i, pic.palette[i]);
end;
procedure loadPic(var pic:PictData);
@ -81,30 +23,6 @@ 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)
@ -120,18 +38,7 @@ begin
writeln('magic: ', pic.magic, ' mode:', pic.mode);
initgraphics;
setBlackPalette;
loadPalette(pic);
loadPic(pic);
fadeIn(pic);
read(ch);
if ch <> 'k' then
begin
fadeOut(pic);
initgraphics;
end;
end.