examples/viewpict: implement fade-in and fade-out

examples/viewpict.pas

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