home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / FGFADE11.ZIP / FADE.FOR < prev    next >
Text File  |  1995-02-13  |  7KB  |  197 lines
  1. C*****************************************************************************
  2. C                                                                            *
  3. C  FADE.FOR                                                                  *
  4. C                                                                            *
  5. C  This program demonstrates how to perform a smooth palette fade with       *
  6. C  Fastgraph.  This example assumes a 256-color video mode with 6-bit DAC    *
  7. C  values (i.e., between 0 and 63).  These values are defined at the top of  *
  8. C  this file, so you can change them easily.                                 *
  9. C                                                                            *
  10. C  The fadein() and fadeout() routines in this program were originally       *
  11. C  written by John Wagner, author of the IMPROCES image processing program.  *
  12. C                                                                            *
  13. C  To compile this program and link it with Fastgraph version 4.0:           *
  14. C                                                                            *
  15. C     FL /FPi /4I2 /4Nt /AM FADE.FOR /link FGM   (MS FORTRAN 4.x/5.x)        *
  16. C     FL32 FADE.FOR FG32MSF.LIB                  (FORTRAN PowerStation)      *
  17. C                                                                            *
  18. C  This program also can be linked with Fastgraph/Light if you replace the   *
  19. C  FGM library reference with FGLM.                                          *
  20. C                                                                            *
  21. C  Fastgraph (tm) and Fastgraph/Light (tm) are graphics libraries published  *
  22. C  by Ted Gruber Software.  For more info, please call, write, or FAX.       *
  23. C                                                                            *
  24. C  Ted Gruber Software                           orders/info (702) 735-1980  *
  25. C  PO Box 13408                                          FAX (702) 735-4603  *
  26. C  Las Vegas, NV  89112                                  BBS (702) 796-7134  *
  27. C                                                                            *
  28. C*****************************************************************************
  29.  
  30. $INCLUDE: 'C:\FG\FASTGRAF.FI'
  31.  
  32.       PROGRAM MAIN
  33.  
  34. C *** these values can be changed for different video modes
  35.  
  36.       INTEGER NDACS, NCOLORS, VIDEO_MODE
  37.       PARAMETER (NDACS = 256)
  38.       PARAMETER (NCOLORS = 64)
  39.       PARAMETER (VIDEO_MODE = 19)
  40.  
  41.       INTEGER DELAY
  42.       INTEGER OLD_MODE
  43.  
  44.       INTEGER FG_GETMODE, FG_MEASURE, FG_TESTMODE
  45.  
  46. C *** in case we're compiling for protected mode
  47.  
  48.       CALL FG_INITPM
  49.  
  50. C *** make sure the requested graphics mode is available
  51.  
  52.       IF (FG_TESTMODE(VIDEO_MODE,1) .EQ. 0) THEN
  53.          STOP 'This program requires a 256-color graphics mode.'
  54.       END IF
  55.  
  56. C *** calculate the base delay between DAC updates
  57.  
  58.       DELAY = FG_MEASURE() / 128
  59.  
  60. C *** initialize Fastgraph for the requested video mode
  61.  
  62.       OLD_MODE = FG_GETMODE()
  63.       CALL FG_SETMODE(VIDEO_MODE)
  64.  
  65. C *** for each PCX file, fade it in and then back out
  66.  
  67.       CALL FADEIN('TOMMY.PCX'//CHAR(0),DELAY)
  68.       CALL FG_WAITFOR(36)
  69.       CALL FADEOUT(DELAY)
  70.       CALL FG_WAITFOR(18)
  71.  
  72.       CALL FADEIN('BALLOONS.PCX'//CHAR(0),DELAY*2)
  73.       CALL FG_WAITFOR(36)
  74.       CALL FADEOUT(DELAY*2)
  75.       CALL FG_WAITFOR(18)
  76.  
  77.       CALL FADEIN('MOUSE.PCX'//CHAR(0),DELAY*4)
  78.       CALL FG_WAITFOR(36)
  79.       CALL FADEOUT(DELAY*4)
  80.  
  81. C *** restore the original video mode and screen attributes
  82.  
  83.       CALL FG_SETMODE(OLD_MODE)
  84.       CALL FG_RESET
  85.  
  86.       STOP ' '
  87.       END
  88.  
  89. C*****************************************************************************
  90. C                                                                            *
  91. C  FADEIN                                                                    *
  92. C                                                                            *
  93. C  Display an image by gradually increasing each DAC's RGB components to     *
  94. C  their original values.                                                    *
  95. C                                                                            *
  96. C*****************************************************************************
  97.  
  98.       SUBROUTINE FADEIN(PCX_FILE,DELAY)
  99.       CHARACTER PCX_FILE*(*)
  100.       INTEGER DELAY
  101.  
  102.       INTEGER NDACS, NCOLORS
  103.       PARAMETER (NDACS = 256)
  104.       PARAMETER (NCOLORS = 64)
  105.  
  106.       INTEGER*1 DACS1(0:NDACS*3-1), DACS2(0:NDACS*3-1)
  107.       COMMON DACS1, DACS2
  108.  
  109.       INTEGER I, J
  110.       INTEGER STATUS
  111.       INTEGER TARGET
  112.  
  113.       INTEGER FG_PCXPAL, FG_SHOWPCX
  114.  
  115. C *** get the target DAC values from the PCX file
  116.  
  117.       STATUS = FG_PCXPAL(PCX_FILE,DACS1)
  118.  
  119. C *** zero all of the DACs
  120.  
  121.       DO 10 I = 0,NDACS*3-1
  122.          DACS2(I) = 0
  123. 10    CONTINUE
  124.       CALL FG_SETDACS(0,NDACS,DACS2)
  125.  
  126. C *** display the blacked-out PCX image
  127.  
  128.       STATUS = FG_SHOWPCX(PCX_FILE,1)
  129.  
  130. C *** cycle through the DACs, gradually increasing them to their old values
  131.  
  132.       DO 30 J = 0,NCOLORS-1
  133.  
  134. C ****** increment each RGB component if it is below its old value
  135.  
  136.          TARGET = NCOLORS - J
  137.  
  138.          DO 20 I = 0,NDACS*3-1
  139.             IF (DACS1(I) .GT. TARGET .AND. DACS2(I) .LT. DACS1(I))
  140.      +         DACS2(I) = DACS2(I) + 1
  141. 20       CONTINUE
  142.  
  143. C ****** update the DACs each time through the loop
  144.  
  145.          CALL FG_STALL(DELAY)
  146.          CALL FG_SETDACS(0,NDACS,DACS2)
  147.  
  148. 30    CONTINUE
  149.  
  150.       RETURN
  151.       END
  152.  
  153. C*****************************************************************************
  154. C                                                                            *
  155. C  FADEOUT                                                                   *
  156. C                                                                            *
  157. C  Erase an image by gradually fading each DAC's RGB components to black.    *
  158. C                                                                            *
  159. C*****************************************************************************
  160.  
  161.       SUBROUTINE FADEOUT(DELAY)
  162.       INTEGER DELAY
  163.  
  164.       INTEGER NDACS, NCOLORS
  165.       PARAMETER (NDACS = 256)
  166.       PARAMETER (NCOLORS = 64)
  167.  
  168.       INTEGER*1 DACS1(0:NDACS*3-1), DACS2(0:NDACS*3-1)
  169.       COMMON DACS1, DACS2
  170.  
  171.       INTEGER I, J
  172.  
  173. C *** load the dacs1 and dacs2 arrays with the current DAC values
  174.  
  175.       CALL FG_GETDACS(0,NDACS,DACS1)
  176.       CALL FG_GETDACS(0,NDACS,DACS2)
  177.  
  178. C *** cycle through the DACs, gradually reducing them to 0 (black)
  179.  
  180.       DO 20 J = 0,NCOLORS-1
  181.  
  182. C ****** decrement each RGB component if it is above 0
  183.  
  184.          DO 10 I = 0,NDACS*3-1
  185.             IF (DACS2(I) .GT. 0) DACS2(I) = DACS2(I) - 1
  186. 10       CONTINUE
  187.  
  188. C ****** update the DACs each time through the loop
  189.  
  190.          CALL FG_STALL(DELAY)
  191.          CALL FG_SETDACS(0,NDACS,DACS2)
  192.  
  193. 20    CONTINUE
  194.  
  195.       RETURN
  196.       END
  197.