Unit FX;

Interface

Uses Crt;

Type 
 PaletteInfo = Array[1..768] Of Byte;
 PalettePtr = ^PaletteInfo;

Var
 CurrentPalette : PalettePtr;

Procedure FadeOut(Speed, Degree, FirstColor, LastColor : Byte);
{ This takes the palette and decrements it by a ratio instead of a set 
  amount, thus preserving the color hues.  Speed determines how much
  delay between decrements (in milliseconds), and degree determines
  how much the ratio is per decrement.  Experiment! Some good values
  for speed and degree are 30 and 5 respectively. FirstColor specifies
  which color slot to start at, and LastColor species which slot to stop
  at, thus 4 and 240, would only fade the palette slots from 4 to 240, 
  allowing a limited fade as well.  To fade the whole palette, just use
  0 and 255 for the FirstColor and LastColor respectively. }

Procedure FadeIn(Speed, Degree, FirstColor, LastColor : Byte);
{ This takes the palette, clears the viewable palette and then steadly
  increments the palette by a ratio to preserve color hues.  Speed and
  degree work like in FadeOut, except it's time between increments and
  degree of incrementation.  FirstColor and LastColor work exactly like
  the do in FadeOut.}

Implementation

Procedure FadeOut(Speed, Degree, FirstColor, LastColor : Byte);
Var
 Loop, Loop2, Lookup : Word;
 Red, Green, Blue : Byte;
 TempPalette : Array[1..768] of Byte;
Begin
 Move(CurrentPalette^, TempPalette, 768);
 For Loop2 := 1 to ((63 Div Degree)+1) do
 Begin {1st For}
  For Loop := FirstColor to LastColor do
    Begin {2nd For}
     Lookup := Loop Shl 1 + Loop + 1;
     If TempPalette[Lookup] > 5 Then
     Dec(TempPalette[Lookup], Degree)
     Else TempPalette[Lookup] := 0;
     Red := TempPalette[Lookup];
     If TempPalette[Lookup+1] > 5 Then
     Dec(TempPalette[Lookup+1], Degree)
     Else TempPalette[Lookup+1] := 0;
     Green := TempPalette[Lookup+1];
     If TempPalette[Lookup+2] > 5 Then
     Dec(TempPalette[Lookup+2], Degree)
     Else TempPalette[Lookup+2] := 0;
     Blue := TempPalette[Lookup+2];
     Asm
      mov dx, 3c6h
      mov ax, 255
      out dx, al
      mov dx, 3c8h
      mov ax, loop
      out dx, al
      mov dx, 3c9h
      mov al, red
      out dx, al
      mov al, Green
      out dx, al
      mov al, Blue
      out dx, al
     End; {Asm}
   End; {2nd For}
  Delay(Speed);
 End; {1st For}
End; {Procedure}

Procedure FadeIn(Speed, Degree, FirstColor, LastColor : Byte);
Var
 Loop, Loop2, Lookup  : Word;
 Red, Green, Blue, RDiff, GDiff, BDiff : Byte;
 TempPal : Array[1..768] of Byte;
 Ratios : Array[1..768] of Byte;
Begin
 For Loop := 1 to 768 do
  TempPal[Loop] := 0;
 For Loop := FirstColor to LastColor do
  Begin
   Lookup := Loop Shl 1 + Loop + 1;
   RDiff := CurrentPalette^[Lookup];
   GDiff := CurrentPalette^[Lookup+1];
   BDiff := CurrentPalette^[Lookup+2];
   If RDiff = 0 Then
    Begin
     Ratios[Lookup] := 0;
     RDiff := 1;
     If GDiff = 0 Then
      Begin
       Ratios[Lookup+1] := 0;
       GDiff := 1;
       Ratios[Lookup+2] := Degree;
      End
     Else Begin
     Ratios[Lookup+1] := Degree;
     Ratios[Lookup+2] := Round(Degree*(BDiff/GDiff));
     End;
    End
   Else Begin
   Ratios[Lookup] := Degree;
   Ratios[Lookup+1] := Round(Degree*(GDiff/RDiff));
   Ratios[Lookup+2] := Round(Degree*(BDiff/RDiff));
   End;
  End;
 For Loop2 := 1 to ((63 Div Degree)+1) do
 Begin
  For Loop := FirstColor to LastColor do
    Begin
     Lookup := Loop Shl 1 + Loop + 1;
     If TempPal[Lookup] < CurrentPalette^[Lookup]-Degree Then
      Inc(TempPal[Lookup], Degree)
       Else TempPal[Lookup] := CurrentPalette^[Lookup];
     Red := TempPal[Lookup];
     If TempPal[Lookup+1] < CurrentPalette^[Lookup+1]-Degree Then
      Inc(TempPal[Lookup+1], Ratios[Lookup+1])
       Else TempPal[Lookup+1] := CurrentPalette^[Lookup+1];
     Green := TempPal[Lookup+1];
     If TempPal[Lookup+2] < CurrentPalette^[Lookup+2]-Degree Then
      Inc(TempPal[Lookup+2], Ratios[Lookup+2])
       Else TempPal[Lookup+2] := CurrentPalette^[Lookup+2];
     Blue := TempPal[Lookup+2];
     Asm
      mov dx, 3c6h
      mov ax, 255
      out dx, al
      mov dx, 3c8h
      mov ax, loop
      out dx, al
      mov dx, 3c9h
      mov al, red
      out dx, al
      mov al, Green
      out dx, al
      mov al, Blue
      out dx, al
     End;
   End;
  Delay(Speed);
 End;
End;

Begin
 New(CurrentPalette);
End.


{
Thomas Nagashima
Georgia Institute of Technology, Atlanta Georgia, 30332
uucp:	  ...!{decvax,hplabs,ncar,purdue,rutgers}!gatech!prism!gt4700c
Internet: gt4700c@prism.gatech.edu
}