C*****************************************************************************
C                                                                            *
C  FADE.FOR                                                                  *
C                                                                            *
C  This program demonstrates how to perform a smooth palette fade with       *
C  Fastgraph.  This example assumes a 256-color video mode with 6-bit DAC    *
C  values (i.e., between 0 and 63).  These values are defined at the top of  *
C  this file, so you can change them easily.                                 *
C                                                                            *
C  The fadein and fadeout routines in this program were originally developed *
C  by John Wagner, author of the IMPROCES image processing program.          *
C                                                                            *
C  To compile this program and link it with Fastgraph:                       *
C                                                                            *
C     FL /FPi /4I2 /4Nt /AM FADE.FOR /link FGM                               *
C                                                                            *
C  This program also can be linked with Fastgraph/Light if you replace the   *
C  FGM library reference with FGLM.                                          *
C                                                                            *
C  Fastgraph (tm) and Fastgraph/Light (tm) are graphics libraries published  *
C  by Ted Gruber Software.  For more info, please call, write, or FAX.       *
C                                                                            *
C  Ted Gruber Software                           orders/info (702) 735-1980  *
C  PO Box 13408                                          FAX (702) 735-4603  *
C  Las Vegas, NV  89112                                  BBS (702) 796-7134  *
C                                                                            *
C*****************************************************************************

$INCLUDE: 'C:\FG\INTRFACE.FOR'

      PROGRAM MAIN

C *** these values can be changed for different video modes

      INTEGER NDACS, NCOLORS, VIDEO_MODE
      PARAMETER (NDACS = 256)
      PARAMETER (NCOLORS = 64)
      PARAMETER (VIDEO_MODE = 19)

      INTEGER DELAY
      INTEGER OLD_MODE
      INTEGER STATUS

      INTEGER FG_ALLOCATE, FG_FREEPAGE
      INTEGER FG_GETMODE, FG_MEASURE, FG_TESTMODE

C *** make sure the requested graphics mode is available

      IF (FG_TESTMODE(VIDEO_MODE,2) .EQ. 0) THEN
         STOP 'This program requires a 256-color graphics mode.'
      END IF

C *** calculate the base delay between DAC updates

      DELAY = FG_MEASURE() / 128

C *** initialize Fastgraph for the requested video mode

      OLD_MODE = FG_GETMODE()
      CALL FG_SETMODE(VIDEO_MODE)
      STATUS = FG_ALLOCATE(1)

C *** for each PCX file, fade it in and then back out

      CALL FADEIN('TGS.PCX'//CHAR(0),DELAY)
      CALL FG_WAITFOR(36)
      CALL FADEOUT(DELAY)
      CALL FG_WAITFOR(18)

      CALL FADEIN('BALLOONS.PCX'//CHAR(0),DELAY*2)
      CALL FG_WAITFOR(36)
      CALL FADEOUT(DELAY*2)
      CALL FG_WAITFOR(18)

      CALL FADEIN('MOUSE.PCX'//CHAR(0),DELAY*4)
      CALL FG_WAITFOR(36)
      CALL FADEOUT(DELAY*4)

C *** restore the original video mode and screen attributes

      STATUS = FG_FREEPAGE(1)
      CALL FG_SETMODE(OLD_MODE)
      CALL FG_RESET

      STOP ' '
      END

C*****************************************************************************
C                                                                            *
C  FADEIN                                                                    *
C                                                                            *
C  Display an image by gradually increasing each DAC's RGB components to     *
C  their original values.                                                    *
C                                                                            *
C*****************************************************************************

      SUBROUTINE FADEIN(PCX_FILE,DELAY)
      CHARACTER PCX_FILE*(*)
      INTEGER DELAY

      INTEGER NDACS, NCOLORS
      PARAMETER (NDACS = 256)
      PARAMETER (NCOLORS = 64)

      INTEGER*1 DACS1(0:NDACS*3-1), DACS2(0:NDACS*3-1)
      COMMON DACS1, DACS2

      INTEGER I, J
      INTEGER STATUS
      INTEGER TARGET

      INTEGER FG_DISPPCX

C *** erase the visual page

      CALL FG_SETPAGE(0)
      CALL FG_ERASE

C *** display the PCX file on the hidden page

      CALL FG_SETPAGE(1)
      CALL FG_MOVE(0,0)
      STATUS = FG_DISPPCX(PCX_FILE,0)
      CALL FG_SETPAGE(0)
 
C *** get its DAC values

      CALL FG_GETDACS(0,NDACS,DACS1)

C *** zero all of the DACs

      DO 10 I = 0,NDACS*3-1
         DACS2(I) = 0
10    CONTINUE
      CALL FG_SETDACS(0,NDACS,DACS2)

C *** display the blacked-out image on the visual page

      CALL FG_COPYPAGE(1,0)

C *** cycle through the DACs, gradually increasing them to their old values

      DO 30 J = 0,NCOLORS-1

C ****** increment each RGB component if it is below its old value

         TARGET = NCOLORS - J

         DO 20 I = 0,NDACS*3-1
            IF (DACS1(I) .GT. TARGET .AND. DACS2(I) .LT. DACS1(I))
     +         DACS2(I) = DACS2(I) + 1
20       CONTINUE

C ****** update the DACs each time through the loop

         CALL FG_STALL(DELAY)
         CALL FG_SETDACS(0,NDACS,DACS2)

30    CONTINUE

      RETURN
      END

C*****************************************************************************
C                                                                            *
C  FADEOUT                                                                   *
C                                                                            *
C  Erase an image by gradually fading each DAC's RGB components to black.    *
C                                                                            *
C*****************************************************************************

      SUBROUTINE FADEOUT(DELAY)
      INTEGER DELAY

      INTEGER NDACS, NCOLORS
      PARAMETER (NDACS = 256)
      PARAMETER (NCOLORS = 64)

      INTEGER*1 DACS1(0:NDACS*3-1), DACS2(0:NDACS*3-1)
      COMMON DACS1, DACS2

      INTEGER I, J

C *** load the dacs1 and dacs2 arrays with the current DAC values

      CALL FG_GETDACS(0,NDACS,DACS1)
      CALL FG_GETDACS(0,NDACS,DACS2)
 
C *** cycle through the DACs, gradually reducing them to 0 (black)

      DO 20 J = 0,NCOLORS-1

C ****** decrement each RGB component if it is above 0

         DO 10 I = 0,NDACS*3-1
            IF (DACS2(I) .GT. 0) DACS2(I) = DACS2(I) - 1
10       CONTINUE

C ****** update the DACs each time through the loop

         CALL FG_STALL(DELAY)
         CALL FG_SETDACS(0,NDACS,DACS2)

20    CONTINUE

      RETURN
      END
