C*****************************************************************************
C                                                                            *
C  EFFECTS.FOR                                                               *
C                                                                            *
C  This program demonstrates several methods of fading in an image from an   *
C  off-screen video page using either Fastgraph or Fastgraph/Light.  The set *
C  of routines provided herein are written for 320x200 graphics video modes, *
C  but they could easily be extended to work in other resolutions.           *
C                                                                            *
C  The examples are by no means all inclusive.  Rather, their purpose is to  *
C  illustrate a few methods of creating special effects with Fastgraph or    *
C  Fastgraph/Light.                                                          *
C                                                                            *
C  To compile this program and link it with Fastgraph version 4.0:           *
C                                                                            *
C     FL /FPi /4I2 /4Nt /AM EFFECTS.FOR /link FGM   (MS FORTRAN 4.x/5.x)     *
C     FL32 EFFECTS.FOR FG32MSF.LIB                  (FORTRAN PowerStation)   *
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\FASTGRAF.FI'

      PROGRAM MAIN

      INTEGER DELAY, SCROLL_DELAY
      COMMON  DELAY, SCROLL_DELAY

      INTEGER OLD_MODE, NEW_MODE
      INTEGER COUNT
      INTEGER STATUS
      INTEGER*4 START_TIME

      INTEGER FG_ALLOCATE, FG_FREEPAGE
      INTEGER FG_BESTMODE, FG_GETMODE, FG_MEASURE, FG_SHOWPPR
      INTEGER*4 FG_GETCLOCK

C *** in case we're compiling for protected mode

      CALL FG_INITPM

C *** make sure a 320x200 color graphics mode is available

      NEW_MODE = FG_BESTMODE(320,200,2)
      IF (NEW_MODE .LT. 0 .OR. NEW_MODE .EQ. 12) THEN
         STOP 'This program requires a 320x200 color graphics mode.'
      END IF

C *** determine the number of delay units per half clock tick

      DELAY = FG_MEASURE() / 2

C *** initialize Fastgraph for the selected video mode

      OLD_MODE = FG_GETMODE()
      CALL FG_SETMODE(NEW_MODE)
      STATUS = FG_ALLOCATE(1)
      
C *** display a packed pixel run file on a hidden page

      CALL FG_SETHPAGE(1)
      CALL FG_SETPAGE(1)
      CALL FG_MOVE(0,199)
      STATUS = FG_SHOWPPR('FG.PPR'//CHAR(0),320)
      CALL FG_SETPAGE(0)

C *** compute the number of delay units needed to make the text scroll
C *** down at the same rate, regardless of the CPU speed or video mode

      COUNT = 0
      CALL FG_WAITFOR(1)
      START_TIME = FG_GETCLOCK()
10    CALL FG_SCROLL(0,319,0,7,4,1)
      COUNT = COUNT + 1
      IF (FG_GETCLOCK() .EQ. START_TIME) GO TO 10

      SCROLL_DELAY = (DELAY / 8) - (DELAY * 2) / COUNT
      IF (SCROLL_DELAY .LT. 0) SCROLL_DELAY = 0

C *** demonstrate the inward tunnel effect

      CALL ANNOUNCE('inward tunnel effect')
      CALL INWARD_TUNNEL_EFFECT(0)
      CALL FG_WAITFOR(27)
      CALL ANNOUNCE('inward tunnel effect with delay')
      CALL INWARD_TUNNEL_EFFECT(DELAY)
      CALL FG_WAITFOR(27)

C *** demonstrate the outward tunnel effect

      CALL ANNOUNCE('outward tunnel effect')
      CALL OUTWARD_TUNNEL_EFFECT(0)
      CALL FG_WAITFOR(27)
      CALL ANNOUNCE('outward tunnel effect with delay')
      CALL OUTWARD_TUNNEL_EFFECT(DELAY)
      CALL FG_WAITFOR(27)

C *** demonstrate the diagonal fade

      CALL ANNOUNCE('diagonal fade')
      CALL DIAGONAL_FADE(0)
      CALL FG_WAITFOR(27)
      CALL ANNOUNCE('diagonal fade with delay')
      CALL DIAGONAL_FADE(DELAY/2)
      CALL FG_WAITFOR(27)

C *** demonstrate the horizontal random fade

      CALL ANNOUNCE('horizontal random fade')
      CALL HORIZONTAL_RANDOM_FADE(DELAY)
      CALL FG_WAITFOR(27)

C *** demonstrate the curtain effect

      CALL ANNOUNCE('curtain')
      CALL CURTAIN(DELAY/8)
      CALL FG_WAITFOR(27)

C *** demonstrate the spiral effect

      CALL ANNOUNCE('spiral')
      CALL SPIRAL_NORMAL(DELAY*2)
      CALL FG_WAITFOR(27)

C *** demonstrate the layered spiral effect

      CALL ANNOUNCE('layered spiral')
      CALL SPIRAL_LAYERED(DELAY)
      CALL FG_WAITFOR(27)

C *** demonstrate the dual spiral effect

      CALL ANNOUNCE('dual spiral')
      CALL SPIRAL_DUAL(DELAY/2)
      CALL FG_WAITFOR(27)

C *** demonstrate the split screen effect

      CALL ANNOUNCE('split screen')
      CALL SPLIT_SCREEN(DELAY/2)
      CALL FG_WAITFOR(27)

C *** demonstrate the unveil effect

      CALL ANNOUNCE('unveil')
      CALL UNVEIL(DELAY/4)
      CALL FG_WAITFOR(27)

C *** demonstrate the "venetian blind" effect

      CALL ANNOUNCE('venetian blind')
      CALL VENETIAN_BLIND(DELAY)
      CALL FG_WAITFOR(27)

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  ANNOUNCE                                                                  *
C                                                                            *
C  Display the name of the special effect we're about to see.                *
C                                                                            *
C*****************************************************************************

      SUBROUTINE ANNOUNCE(MESSAGE)
      CHARACTER*(*) MESSAGE

      INTEGER Y

C *** clear the screen

      CALL FG_ERASE

C *** display the specified message at the top row

      CALL FG_SETCOLOR(10)
      CALL FG_JUSTIFY(0,-1)
      CALL FG_MOVE(160,15)
      CALL FG_FONTSIZE(16)
      CALL FG_PRINT(MESSAGE,LEN(MESSAGE))

C *** scroll the message to the center of the screen

      CALL FG_SETCOLOR(0)

      DO 10 Y = 0,95,4
         CALL FG_SCROLL(0,319,Y,Y+15,4,1)
         CALL FG_STALL(SCROLL_DELAY)
10    CONTINUE

C *** wait 1.5 seconds

      CALL FG_WAITFOR(27)

      RETURN
      END

C*****************************************************************************
C                                                                            *
C  IRANDOM                                                                   *
C                                                                            *
C  Random number generator used in some of the effects.  It returns an       *
C  integer between min and max inclusive.                                    *
C                                                                            *
C*****************************************************************************

      INTEGER FUNCTION IRANDOM(MIN,MAX)
      INTEGER MIN, MAX

      INTEGER SEED, TEMP
      DATA SEED /12345/

      TEMP = IEOR(SEED,ISHFT(SEED,-7))
      SEED = IAND(IEOR(ISHFT(TEMP,8),TEMP),#7FFF)
      IRANDOM = MOD(SEED,MAX-MIN+1) + MIN

      RETURN
      END

C*****************************************************************************
C                                                                            *
C  CURTAIN                                                                   *
C                                                                            *
C  Reveal each row, one at a time, starting from the bottom and proceeding   *
C  to the top.  This gives the effect of a curtain rising, hence the name.   *
C                                                                            *
C*****************************************************************************

      SUBROUTINE CURTAIN(DELAY)
      INTEGER DELAY

      INTEGER Y

      DO 10 Y = 199,0,-1
         CALL FG_RESTORE(0,319,Y,Y)
         CALL FG_STALL(DELAY)
10    CONTINUE

      RETURN
      END

C***************************************************************************** 
C                                                                            *
C  DIAGONAL_FADE                                                             *
C                                                                            *
C  This reveals the hidden page in two diagonal segments, separated by an    *
C  imaginary line extending from the lower left corner to the upper right    *
C  corner of the screen.  We start with the top line of the left segment and *
C  the bottom line of the right segment, and continue until the entire       *
C  screen is revealed.                                                       *
C                                                                            *
C*****************************************************************************

      SUBROUTINE DIAGONAL_FADE(DELAY)
      INTEGER DELAY

      INTEGER XMIN, XMAX
      INTEGER YMIN, YMAX

      XMIN = 0
      XMAX = 319
      YMIN = 0
      YMAX = 199

10    IF (XMAX .GT. 0) THEN
         CALL FG_RESTORE(0,XMAX,YMIN,YMIN+4)
         CALL FG_RESTORE(XMIN,319,YMAX-4,YMAX)
         CALL FG_STALL(DELAY)

         XMIN = XMIN + 8
         XMAX = XMAX - 8
         YMIN = YMIN + 5
         YMAX = YMAX - 5
         GO TO 10
      ENDIF

      RETURN
      END

C*****************************************************************************
C                                                                            *
C  HORIZONTAL_RANDOM_FADE                                                    *
C                                                                            *
C  In this effect, the screen is divided into a series of two-pixel high     *
C  rows.  Each row is revealed in random parts from left to right.  This     *
C  process repeats 20 times, once for each row.  At the end, a call to the   *
C  CALL FG_restore routine guarantees that all rows are transferred.              *
C                                                                            *
C*****************************************************************************

      SUBROUTINE HORIZONTAL_RANDOM_FADE(DELAY)
      INTEGER DELAY

      INTEGER I, J
      INTEGER XMIN, XMAX
      INTEGER Y
      INTEGER XPOS(0:99)

      DO 10 J = 0,99
         XPOS(J) = 0
10    CONTINUE

      DO 30 I = 1,20
         DO 20 J = 0,99
            XMIN = XPOS(J)
            IF (XMIN .LT. 320) THEN
               XMAX = XMIN + IRANDOM(1,10) * 8
               IF (XMAX .GT. 320) XMAX = 320
               Y = J * 2
               CALL FG_RESTORE(XMIN,XMAX-1,Y,Y+1)
               XPOS(J) = XMAX
            END IF
20       CONTINUE
         CALL FG_STALL(DELAY)
30    CONTINUE

C *** make sure we got them all

      CALL FG_RESTORE(0,319,0,199)

      RETURN
      END

C*****************************************************************************
C                                                                            *
C  INWARD_TUNNEL_EFFECT                                                      *
C                                                                            *
C  Starting at the screen edges, reveal the screen through a series of       *
C  concentric hollow rectangles.                                             *
C                                                                            *
C*****************************************************************************

      SUBROUTINE INWARD_TUNNEL_EFFECT(DELAY)
      INTEGER DELAY

      INTEGER XMIN, XMAX
      INTEGER YMIN, YMAX

      XMIN = 0
      XMAX = 319
      YMIN = 0
      YMAX = 199

10    IF (XMIN .LT. XMAX) THEN
         CALL FG_RESTORE(0,319,YMIN,YMIN+4)
         CALL FG_RESTORE(XMAX-7,XMAX,0,199)
         CALL FG_RESTORE(0,319,YMAX-4,YMAX)
         CALL FG_RESTORE(XMIN,XMIN+7,0,199)
         CALL FG_STALL(DELAY)

         XMIN = XMIN + 8
         XMAX = XMAX - 8
         YMIN = YMIN + 5
         YMAX = YMAX - 5
         GO TO 10
      ENDIF

      RETURN
      END

C*****************************************************************************
C                                                                            *
C  OUTWARD_TUNNEL_EFFECT                                                     *
C                                                                            *
C  Starting at the screen center, reveal the screen through a series of      *
C  concentric hollow rectangles.                                             *
C                                                                            *
C*****************************************************************************

      SUBROUTINE OUTWARD_TUNNEL_EFFECT(DELAY)
      INTEGER DELAY

      INTEGER XMIN, XMAX
      INTEGER YMIN, YMAX

      XMIN = 152
      XMAX = 167
      YMIN = 95
      YMAX = 104

10    IF (XMIN .GE. 0) THEN
         CALL FG_RESTORE(XMIN,XMAX,YMIN,YMIN+5)
         CALL FG_RESTORE(XMAX-7,XMAX,YMIN,YMAX)
         CALL FG_RESTORE(XMIN,XMAX,YMAX-4,YMAX)
         CALL FG_RESTORE(XMIN,XMIN+7,YMIN,YMAX)
         CALL FG_STALL(DELAY)

         XMIN = XMIN - 8
         XMAX = XMAX + 8
         YMIN = YMIN - 5
         YMAX = YMAX + 5
         GO TO 10
      ENDIF

      RETURN
      END

C*****************************************************************************
C                                                                            *
C  SPIRAL_DUAL                                                               *
C                                                                            *
C  In this effect, we reveal the screen through two spirals.  One spiral     *
C  emanates clockwise from the screen edges to the screen center, while the  *
C  other emanates counterclockwise from the center to the screen edges.      *
C                                                                            *
C*****************************************************************************

      SUBROUTINE SPIRAL_DUAL(DELAY)
      INTEGER DELAY

      INTEGER XMIN_OUTER, XMAX_OUTER
      INTEGER YMIN_OUTER, YMAX_OUTER
      INTEGER XMIN_INNER, XMAX_INNER
      INTEGER YMIN_INNER, YMAX_INNER

      XMIN_OUTER = 0
      XMAX_OUTER = 319
      YMIN_OUTER = 0
      YMAX_OUTER = 199

      XMIN_INNER = 152
      XMAX_INNER = 167
      YMIN_INNER = 95
      YMAX_INNER = 104

10    IF (XMIN_OUTER .LT. XMIN_INNER) THEN
         CALL FG_RESTORE(XMIN_OUTER,XMAX_OUTER,YMIN_OUTER,YMIN_OUTER+4)
         CALL FG_STALL(DELAY)
         CALL FG_RESTORE(XMIN_INNER,XMAX_INNER,YMAX_INNER-4,YMAX_INNER)
         CALL FG_STALL(DELAY)
         CALL FG_RESTORE(XMAX_OUTER-7,XMAX_OUTER,YMIN_OUTER,YMAX_OUTER)
         CALL FG_STALL(DELAY)
         CALL FG_RESTORE
     +      (XMAX_INNER+1,XMAX_INNER+8,YMIN_INNER,YMAX_INNER)
         CALL FG_STALL(DELAY)
         CALL FG_RESTORE(XMIN_OUTER,XMAX_OUTER,YMAX_OUTER-4,YMAX_OUTER)
         CALL FG_STALL(DELAY)
         CALL FG_RESTORE
     +      (XMIN_INNER-8,XMAX_INNER,YMIN_INNER,YMIN_INNER+4)
         CALL FG_STALL(DELAY)
         CALL FG_RESTORE(XMIN_OUTER,XMIN_OUTER+7,YMIN_OUTER,YMAX_OUTER)
         CALL FG_STALL(DELAY)
         CALL FG_RESTORE
     +      (XMIN_INNER-8,XMIN_INNER-1,YMIN_INNER,YMAX_INNER+5)
         CALL FG_STALL(DELAY)

         XMIN_OUTER = XMIN_OUTER + 8
         XMAX_OUTER = XMAX_OUTER - 8
         YMIN_OUTER = YMIN_OUTER + 5
         YMAX_OUTER = YMAX_OUTER - 5

         XMIN_INNER = XMIN_INNER - 8
         XMAX_INNER = XMAX_INNER + 8
         YMIN_INNER = YMIN_INNER - 5
         YMAX_INNER = YMAX_INNER + 5

         GO TO 10
      END IF

      RETURN
      END

C*****************************************************************************
C                                                                            *
C  SPIRAL_LAYERED                                                            *
C                                                                            *
C  This effect is similar to the normal spiral.  Instead of revealing the    *
C  screen in one iteration, this effect does so in four iterations (layers), *
C  each moving more toward the screen center.                                *
C                                                                            *
C*****************************************************************************

      SUBROUTINE SPIRAL_LAYERED(DELAY)
      INTEGER DELAY

      INTEGER I
      INTEGER XMIN, XMAX
      INTEGER YMIN, YMAX

      DO 20 I = 0,3
         XMIN = I * 8
         XMAX = 319 - XMIN
         YMIN = I * 5
         YMAX = 199 - YMIN

10       IF (XMIN .LT. XMAX) THEN
            CALL FG_RESTORE(XMIN,XMAX,YMIN,YMIN+4)
            CALL FG_STALL(DELAY)
            CALL FG_RESTORE(XMAX-7,XMAX,YMIN,YMAX)
            CALL FG_STALL(DELAY)
            CALL FG_RESTORE(XMIN,XMAX,YMAX-4,YMAX)
            CALL FG_STALL(DELAY)
            CALL FG_RESTORE(XMIN,XMIN+7,YMIN,YMAX)
            CALL FG_STALL(DELAY)

            XMIN = XMIN + 32
            XMAX = XMAX - 32
            YMIN = YMIN + 20
            YMAX = YMAX - 20
            GO TO 10
         END IF
20    CONTINUE

      RETURN
      END

C*****************************************************************************
C                                                                            *
C  SPIRAL_NORMAL                                                             *
C                                                                            *
C  This is a spiral effect in which we reveal the screen as a series of      *
C  rectangles, emanating from the screen edges and proceeding clockwise to   *
C  the center of the screen.                                                 *
C                                                                            *
C*****************************************************************************

      SUBROUTINE SPIRAL_NORMAL(DELAY)
      INTEGER DELAY

      INTEGER XMIN, XMAX
      INTEGER YMIN, YMAX

      XMIN = 0
      XMAX = 319
      YMIN = 0
      YMAX = 199

10    IF (XMIN .LT. XMAX) THEN
         CALL FG_RESTORE(XMIN,XMAX,YMIN,YMIN+19)
         CALL FG_STALL(DELAY)
         CALL FG_RESTORE(XMAX-31,XMAX,YMIN,YMAX)
         CALL FG_STALL(DELAY)
         CALL FG_RESTORE(XMIN,XMAX,YMAX-19,YMAX)
         CALL FG_STALL(DELAY)
         CALL FG_RESTORE(XMIN,XMIN+31,YMIN,YMAX)
         CALL FG_STALL(DELAY)

         XMIN = XMIN + 32
         XMAX = XMAX - 32
         YMIN = YMIN + 20
         YMAX = YMAX - 20
         GO TO 10
      END IF

      RETURN
      END

C*****************************************************************************
C                                                                            *
C  SPLIT_SCREEN                                                              *
C                                                                            *
C  Reveal the top half of from left to right while revealing the bottom half *
C  from right to left.                                                       *
C                                                                            *
C*****************************************************************************

      SUBROUTINE SPLIT_SCREEN(DELAY)
      INTEGER DELAY

      INTEGER XMIN, XMAX

      XMIN = 0
      XMAX = 319

10    IF (XMAX .GT. 0) THEN
         CALL FG_RESTORE(XMIN,XMIN+7,0,99)
         CALL FG_RESTORE(XMAX-7,XMAX,100,199)
         CALL FG_STALL(DELAY)
         XMIN = XMIN + 8
         XMAX = XMAX - 8
         GO TO 10
      END IF

      RETURN
      END

C*****************************************************************************
C                                                                            *
C  UNVEIL                                                                    *
C                                                                            *
C  Starting at the center, reveal the screen in small horizontal increments  *
C  until we reach the left and right edges.                                  *
C                                                                            *
C*****************************************************************************

      SUBROUTINE UNVEIL(DELAY)
      INTEGER DELAY

      INTEGER XMIN, XMAX

      XMIN = 152
      XMAX = 167

10    IF (XMIN .GE. 0) THEN
         CALL FG_RESTORE(XMIN,XMIN+7,0,199)
         CALL FG_RESTORE(XMAX-7,XMAX,0,199)
         CALL FG_STALL(DELAY)
         XMIN = XMIN - 8
         XMAX = XMAX + 8
         GO TO 10
      END IF

      RETURN
      END

C*****************************************************************************
C                                                                            *
C  VENETIAN_BLIND                                                            *
C                                                                            *
C  Reveal the screen in four iterations, each revealing every fourth row.    *
C  The effect produced resembles opening a Venetian blind.                   *
C                                                                            *
C*****************************************************************************

      SUBROUTINE VENETIAN_BLIND(DELAY)
      INTEGER DELAY

      INTEGER Y

      DO 10 Y = 0,199,4
         CALL FG_RESTORE(0,319,Y,Y)
10    CONTINUE
      CALL FG_STALL(DELAY)

      DO 20 Y = 1,199,4
         CALL FG_RESTORE(0,319,Y,Y)
20    CONTINUE
      CALL FG_STALL(DELAY)

      DO 30 Y = 2,199,4
         CALL FG_RESTORE(0,319,Y,Y)
30    CONTINUE
      CALL FG_STALL(DELAY)

      DO 40 Y = 3,199,4
         CALL FG_RESTORE(0,319,Y,Y)
40    CONTINUE
      CALL FG_STALL(DELAY)

      RETURN
      END
