Collection of Hack-Phreak Scene Programs/cleanhpvac.zip/cleanhpvac/FGFADE11.ZIP/FADE.PAS

Pascal/Delphi Source File | 1995-02-13 | 7KB | 214 lines

{*****************************************************************************
*                                                                            *
*  FADE.PAS                                                                  *
*                                                                            *
*  This program demonstrates how to perform a smooth palette fade with       *
*  Fastgraph.  This example assumes a 256-color video mode with 6-bit DAC    *
*  values (i.e., between 0 and 63).  These values are defined at the top of  *
*  this file, so you can change them easily.                                 *
*                                                                            *
*  The fadein() and fadeout() routines in this program were originally       *
*  written by John Wagner, author of the IMPROCES image processing program.  *
*                                                                            *
*  To compile this program and link it with Fastgraph 4.0 or FG/Light 4.0:   *
*                                                                            *
*     Borland/Turbo Pascal (real mode):                                      *
*        TPC FADE                                                            *
*                                                                            *
*     Borland Pascal (protected mode - requires Fastgraph):                  *
*        BPC /CP FADE                                                        *
*                                                                            *
*  Fastgraph (tm) and Fastgraph/Light (tm) are graphics libraries published  *
*  by Ted Gruber Software.  For more info, please call, write, or FAX.       *
*                                                                            *
*  Ted Gruber Software                           orders/info [phone]  *
*  PO Box 13408                                          FAX [phone]  *
*  Las Vegas, NV  89112                                  BBS [phone]  *
*                                                                            *
*****************************************************************************}

program main;
uses fgmain, fgmisc, fgpcx;

{ these values can be changed for different video modes }

const

  NDACS = 256;
  NCOLORS = 64;
  VIDEO_MODE = 19;

{ this is a clean way to do DACs }

type

  RGB = record
    r, g, b : byte;
  end;

{ these global arrays hold two complete sets of DAC values }

var

  dacs1, dacs2 : array [0..NDACS-1] of RGB;

{*****************************************************************************
*                                                                            *
*  fadein                                                                    *
*                                                                            *
*  Display an image by gradually increasing each DAC's RGB components to     *
*  their original values.                                                    *
*                                                                            *
*****************************************************************************}

procedure fadein (PCXfile : string; delay : integer);

var

  i, j : integer;
  status : integer;
  target : integer;

begin

  { get the target DAC values from the PCX file }

  status := fg_pcxpal(PCXfile,dacs1);

  { zero all of the DACs }

  for i := 0 to NDACS-1 do
  begin
    dacs2[i].r := 0;
    dacs2[i].g := 0;
    dacs2[i].b := 0;
  end;
  fg_setdacs(0,NDACS,dacs2);

  { display the blacked-out PCX image }

  status := fg_showpcx(PCXfile,1);

  { cycle through the DACs, gradually increasing them to their old values }

  for j := 0 to NCOLORS-1 do
  begin

    { increment each RGB component if it is below its old value }

    target := NCOLORS - j;

    for i := 0 to NDACS-1 do
    begin
      if (dacs1[i].r > target) and (dacs2[i].r < dacs1[i].r) then inc(dacs2[i].r);
      if (dacs1[i].g > target) and (dacs2[i].g < dacs1[i].g) then inc(dacs2[i].g);
      if (dacs1[i].b > target) and (dacs2[i].b < dacs1[i].b) then inc(dacs2[i].b);
    end;

    { update the DACs each time through the loop }

    fg_stall(delay);
    fg_setdacs(0,NDACS,dacs2);
  end;

end;

{*****************************************************************************
*                                                                            *
*  fadeout                                                                   *
*                                                                            *
*  Erase an image by gradually fading each DAC's RGB components to black.    *
*                                                                            *
*****************************************************************************}

procedure fadeout (delay : integer);

var

  i, j : integer;

begin

  { load the dacs1 and dacs2 arrays with the current DAC values }

  fg_getdacs(0,NDACS,dacs1);
  fg_getdacs(0,NDACS,dacs2);

  { cycle through the DACs, gradually reducing them to 0 (black) }

  for j := 0 to NCOLORS-1 do
  begin

    { decrement each RGB component if it is above 0 }

    for i := 0 to NDACS-1 do
    begin
      if (dacs2[i].r > 0) then dec(dacs2[i].r);
      if (dacs2[i].g > 0) then dec(dacs2[i].g);
      if (dacs2[i].b > 0) then dec(dacs2[i].b);
    end;

    { update the DACs each time through the loop }

    fg_stall(delay);
    fg_setdacs(0,NDACS,dacs2);
  end;

end;

{*****************************************************************************
*                                                                            *
*  main program                                                              *
*                                                                            *
*****************************************************************************}

var

  delay : integer;
  old_mode : integer;

begin

  { in case we're compiling for protected mode }

  fg_initpm;

  { make sure the requested graphics mode is available }

  if (fg_testmode(VIDEO_MODE,1) = 0) then
  begin
    writeln('This program requires a ',NDACS,' color graphics mode.');
    exit;
  end;

  { calculate the base delay between DAC updates }

  delay := fg_measure div 128;

  { initialize Fastgraph for the requested video mode }

  old_mode := fg_getmode;
  fg_setmode(VIDEO_MODE);

  { for each PCX file, fade it in and then back out }

  fadein('TOMMY.PCX'+chr(0),delay);
  fg_waitfor(36);
  fadeout(delay);
  fg_waitfor(18);

  fadein('BALLOONS.PCX'+chr(0),delay*2);
  fg_waitfor(36);
  fadeout(delay*2);
  fg_waitfor(18);

  fadein('MOUSE.PCX'+chr(0),delay*4);
  fg_waitfor(36);
  fadeout(delay*4);

  { restore the original video mode and screen attributes }

  fg_setmode(old_mode);
  fg_reset;
end.