home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / FGFADE11.ZIP / FADE.PAS < prev    next >
Pascal/Delphi Source File  |  1995-02-13  |  7KB  |  214 lines

  1. {*****************************************************************************
  2. *                                                                            *
  3. *  FADE.PAS                                                                  *
  4. *                                                                            *
  5. *  This program demonstrates how to perform a smooth palette fade with       *
  6. *  Fastgraph.  This example assumes a 256-color video mode with 6-bit DAC    *
  7. *  values (i.e., between 0 and 63).  These values are defined at the top of  *
  8. *  this file, so you can change them easily.                                 *
  9. *                                                                            *
  10. *  The fadein() and fadeout() routines in this program were originally       *
  11. *  written by John Wagner, author of the IMPROCES image processing program.  *
  12. *                                                                            *
  13. *  To compile this program and link it with Fastgraph 4.0 or FG/Light 4.0:   *
  14. *                                                                            *
  15. *     Borland/Turbo Pascal (real mode):                                      *
  16. *        TPC FADE                                                            *
  17. *                                                                            *
  18. *     Borland Pascal (protected mode - requires Fastgraph):                  *
  19. *        BPC /CP FADE                                                        *
  20. *                                                                            *
  21. *  Fastgraph (tm) and Fastgraph/Light (tm) are graphics libraries published  *
  22. *  by Ted Gruber Software.  For more info, please call, write, or FAX.       *
  23. *                                                                            *
  24. *  Ted Gruber Software                           orders/info (702) 735-1980  *
  25. *  PO Box 13408                                          FAX (702) 735-4603  *
  26. *  Las Vegas, NV  89112                                  BBS (702) 796-7134  *
  27. *                                                                            *
  28. *****************************************************************************}
  29.  
  30. program main;
  31. uses fgmain, fgmisc, fgpcx;
  32.  
  33. { these values can be changed for different video modes }
  34.  
  35. const
  36.  
  37.   NDACS = 256;
  38.   NCOLORS = 64;
  39.   VIDEO_MODE = 19;
  40.  
  41. { this is a clean way to do DACs }
  42.  
  43. type
  44.  
  45.   RGB = record
  46.     r, g, b : byte;
  47.   end;
  48.  
  49. { these global arrays hold two complete sets of DAC values }
  50.  
  51. var
  52.  
  53.   dacs1, dacs2 : array [0..NDACS-1] of RGB;
  54.  
  55. {*****************************************************************************
  56. *                                                                            *
  57. *  fadein                                                                    *
  58. *                                                                            *
  59. *  Display an image by gradually increasing each DAC's RGB components to     *
  60. *  their original values.                                                    *
  61. *                                                                            *
  62. *****************************************************************************}
  63.  
  64. procedure fadein (PCXfile : string; delay : integer);
  65.  
  66. var
  67.  
  68.   i, j : integer;
  69.   status : integer;
  70.   target : integer;
  71.  
  72. begin
  73.  
  74.   { get the target DAC values from the PCX file }
  75.  
  76.   status := fg_pcxpal(PCXfile,dacs1);
  77.  
  78.   { zero all of the DACs }
  79.  
  80.   for i := 0 to NDACS-1 do
  81.   begin
  82.     dacs2[i].r := 0;
  83.     dacs2[i].g := 0;
  84.     dacs2[i].b := 0;
  85.   end;
  86.   fg_setdacs(0,NDACS,dacs2);
  87.  
  88.   { display the blacked-out PCX image }
  89.  
  90.   status := fg_showpcx(PCXfile,1);
  91.  
  92.   { cycle through the DACs, gradually increasing them to their old values }
  93.  
  94.   for j := 0 to NCOLORS-1 do
  95.   begin
  96.  
  97.     { increment each RGB component if it is below its old value }
  98.  
  99.     target := NCOLORS - j;
  100.  
  101.     for i := 0 to NDACS-1 do
  102.     begin
  103.       if (dacs1[i].r > target) and (dacs2[i].r < dacs1[i].r) then inc(dacs2[i].r);
  104.       if (dacs1[i].g > target) and (dacs2[i].g < dacs1[i].g) then inc(dacs2[i].g);
  105.       if (dacs1[i].b > target) and (dacs2[i].b < dacs1[i].b) then inc(dacs2[i].b);
  106.     end;
  107.  
  108.     { update the DACs each time through the loop }
  109.  
  110.     fg_stall(delay);
  111.     fg_setdacs(0,NDACS,dacs2);
  112.   end;
  113.  
  114. end;
  115.  
  116. {*****************************************************************************
  117. *                                                                            *
  118. *  fadeout                                                                   *
  119. *                                                                            *
  120. *  Erase an image by gradually fading each DAC's RGB components to black.    *
  121. *                                                                            *
  122. *****************************************************************************}
  123.  
  124. procedure fadeout (delay : integer);
  125.  
  126. var
  127.  
  128.   i, j : integer;
  129.  
  130. begin
  131.  
  132.   { load the dacs1 and dacs2 arrays with the current DAC values }
  133.  
  134.   fg_getdacs(0,NDACS,dacs1);
  135.   fg_getdacs(0,NDACS,dacs2);
  136.  
  137.   { cycle through the DACs, gradually reducing them to 0 (black) }
  138.  
  139.   for j := 0 to NCOLORS-1 do
  140.   begin
  141.  
  142.     { decrement each RGB component if it is above 0 }
  143.  
  144.     for i := 0 to NDACS-1 do
  145.     begin
  146.       if (dacs2[i].r > 0) then dec(dacs2[i].r);
  147.       if (dacs2[i].g > 0) then dec(dacs2[i].g);
  148.       if (dacs2[i].b > 0) then dec(dacs2[i].b);
  149.     end;
  150.  
  151.     { update the DACs each time through the loop }
  152.  
  153.     fg_stall(delay);
  154.     fg_setdacs(0,NDACS,dacs2);
  155.   end;
  156.  
  157. end;
  158.  
  159. {*****************************************************************************
  160. *                                                                            *
  161. *  main program                                                              *
  162. *                                                                            *
  163. *****************************************************************************}
  164.  
  165. var
  166.  
  167.   delay : integer;
  168.   old_mode : integer;
  169.  
  170. begin
  171.  
  172.   { in case we're compiling for protected mode }
  173.  
  174.   fg_initpm;
  175.  
  176.   { make sure the requested graphics mode is available }
  177.  
  178.   if (fg_testmode(VIDEO_MODE,1) = 0) then
  179.   begin
  180.     writeln('This program requires a ',NDACS,' color graphics mode.');
  181.     exit;
  182.   end;
  183.  
  184.   { calculate the base delay between DAC updates }
  185.  
  186.   delay := fg_measure div 128;
  187.  
  188.   { initialize Fastgraph for the requested video mode }
  189.  
  190.   old_mode := fg_getmode;
  191.   fg_setmode(VIDEO_MODE);
  192.  
  193.   { for each PCX file, fade it in and then back out }
  194.  
  195.   fadein('TOMMY.PCX'+chr(0),delay);
  196.   fg_waitfor(36);
  197.   fadeout(delay);
  198.   fg_waitfor(18);
  199.  
  200.   fadein('BALLOONS.PCX'+chr(0),delay*2);
  201.   fg_waitfor(36);
  202.   fadeout(delay*2);
  203.   fg_waitfor(18);
  204.  
  205.   fadein('MOUSE.PCX'+chr(0),delay*4);
  206.   fg_waitfor(36);
  207.   fadeout(delay*4);
  208.  
  209.   { restore the original video mode and screen attributes }
  210.  
  211.   fg_setmode(old_mode);
  212.   fg_reset;
  213. end.
  214.