home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / FGFISH20.ZIP / FISHTANK.FOR < prev    next >
Text File  |  1995-02-12  |  10KB  |  309 lines
  1. C************************************************************************
  2. C
  3. C  FISHTANK.FOR -- This program demonstrates multi-object non-destructive
  4. C  animation. The coral background is displayed on page 2 and copied to
  5. C  page 0, the visual page. A packed pixel run file containing the 6 fish
  6. C  is displayed on page 1, and then FG_GETIMAGE is used to load the fish
  7. C  into the fish bitmaps.
  8. C
  9. C  To make the fish move, the background is copied to page 1 and the fish
  10. C  are put over the background using FG_CLPIMAGE and FG_FLPIMAGE. The
  11. C  fish are clipped at the edge of the screen. Page 1 is then copied to
  12. C  page 0 using FG_COPYPAGE. This process is then repeated in a loop.
  13. C
  14. C  To compile this program and link it with Fastgraph 4.0:
  15. C
  16. C     FL /FPi /4I2 /4Nt /AM FISHTANK.FOR /link FGM   (MS FORTRAN 4.x/5.x)
  17. C     FL32 FISHTANK.FOR FG32MSF.LIB                  (FORTRAN PowerStation)
  18. C
  19. C  This program also can be linked with Fastgraph/Light 4.0 (real mode
  20. C  only) if you replace the FGM library reference with FGLM.
  21. C
  22. C  For more examples of animation using Fastgraph, or for an evaluation
  23. C  copy of Fastgraph/Light, call DDBBS at (702) 796-7134. For Fastgraph
  24. C  voice support, call Ted Gruber Software at (702) 735-1980.
  25. C
  26. C************************************************************************
  27.  
  28. $INCLUDE: 'C:\FG\FASTGRAF.FI'
  29.  
  30.       PROGRAM MAIN
  31.       IMPLICIT INTEGER (A-Z)
  32.  
  33.       COMMON /SEED/ SEED
  34.  
  35. C *** fish bitmaps ***
  36.  
  37.       INTEGER*1 FISHES
  38.       COMMON /MAPS/ FISHES(5356), OFFSET(6)
  39.  
  40. C *** palette values
  41.  
  42.       INTEGER COLORS(16)
  43.       DATA COLORS /0,1,2,3,4,5,6,7,16,0,18,19,20,21,22,23/
  44.  
  45. C *** in case we're compiling for protected mode
  46.  
  47.       CALL FG_INITPM
  48.  
  49. C *** make sure the system supports video mode 13 with 4 pages
  50.  
  51.       IF (FG_TESTMODE(13,4) .EQ. 0) THEN
  52.          WRITE(6,*)
  53.          WRITE(6,*) 'This program requires an EGA or VGA card'
  54.          WRITE(6,*) 'with at least 128k. If an EGA card is'
  55.          WRITE(6,*) 'present, it must be the active adapter.'
  56.          STOP ' '
  57.       END IF
  58.  
  59. C *** initialize the video environment
  60.  
  61.       OLD_MODE = FG_GETMODE()
  62.       CALL FG_SETMODE(13)
  63.       CALL FG_PALETTES(COLORS)
  64.       CALL RANDOMIZE
  65.  
  66. C *** get the coral background from a file and put it on page 2
  67.  
  68.       CALL FG_SETPAGE(2)
  69.       CALL FG_MOVE(0,199)
  70.       STATUS = FG_SHOWPPR('CORAL.PPR'//CHAR(0),320)
  71.  
  72. C *** copy the background from page 2 to page 0, the visual page
  73.  
  74.       CALL FG_COPYPAGE(2,0)
  75.  
  76. C *** get the fish
  77.  
  78.       CALL GET_FISH
  79.  
  80. C *** make the fish go
  81.  
  82.       CALL GO_FISH
  83.  
  84. C *** restore the original video state
  85.  
  86.       CALL FG_SETMODE(OLD_MODE)
  87.       CALL FG_RESET
  88.  
  89.       STOP ' '
  90.       END
  91.  
  92. C************************************************************************
  93. C*                                                                      *
  94. C*            get_fish -- fill up the fish bitmap arrays                *
  95. C*                                                                      *
  96. C************************************************************************
  97.  
  98.       SUBROUTINE GET_FISH
  99.       IMPLICIT INTEGER (A-Z)
  100.  
  101.       INTEGER*1 FISHES
  102.       COMMON /MAPS/ FISHES(5356), OFFSET(6)
  103.       COMMON /SIZE/ FISH_X1(6), FISH_Y1(6), WIDTH(6), HEIGHT(6)
  104.  
  105. C *** get the fish from a file and put them on page 1
  106.  
  107.       CALL FG_SETPAGE(1)
  108.       CALL FG_MOVE(0,199)
  109.       STATUS = FG_SHOWPPR('FISH.PPR'//CHAR(0),320)
  110.  
  111. C *** build the fish bitmaps
  112.  
  113.       I = 1
  114.       DO 10 FISH_NUM = 1,6
  115.          CALL FG_MOVE(FISH_X1(FISH_NUM),FISH_Y1(FISH_NUM))
  116.          CALL FG_GETIMAGE(FISHES(I),WIDTH(FISH_NUM),HEIGHT(FISH_NUM))
  117.          OFFSET(FISH_NUM) = I
  118.          I = I + WIDTH(FISH_NUM) * HEIGHT(FISH_NUM)
  119. 10    CONTINUE
  120.  
  121.       RETURN
  122.       END
  123.  
  124. C************************************************************************
  125. C*                                                                      *
  126. C*             go_fish -- make the fish swim around                     *
  127. C*                                                                      *
  128. C************************************************************************
  129.  
  130.       SUBROUTINE GO_FISH
  131.       IMPLICIT INTEGER (A-Z)
  132.  
  133. C     There are 11 fish total, and 6 different kinds of fish. These
  134. C     arrays keep track of what kind of fish each fish is, and how each
  135. C     fish moves:
  136. C
  137. C     fish()   -- which fish bitmap applies to this fish?
  138. C     x()      -- starting x coordinate
  139. C     y()      -- starting y coordinate
  140. C
  141. C     xmin()   -- how far left (off screen) the fish can go
  142. C     xmax()   -- how far right (off screen) the fish can go
  143. C     xinc()   -- how fast the fish goes left and right
  144. C     dir()    -- starting direction for each fish
  145. C
  146. C     ymin()   -- how far up this fish can go
  147. C     ymax()   -- how far down this fish can go
  148. C     yinc()   -- how fast the fish moves up or down
  149. C     yturn()  -- how long fish can go in the vertical direction
  150. C               before stopping or turning around
  151. C     ycount() -- counter to compare to yturn
  152.  
  153.       PARAMETER (NFISH = 11)
  154.  
  155.       INTEGER*1 KEY, AUX
  156.  
  157.       INTEGER*1 FISHES
  158.       COMMON /MAPS/ FISHES(5356), OFFSET(6)
  159.  
  160.       INTEGER FISH(NFISH), X(NFISH), Y(NFISH)
  161.       INTEGER XMIN(NFISH), XMAX(NFISH), XINC(NFISH)
  162.       INTEGER YMIN(NFISH), YMAX(NFISH), YINC(NFISH)
  163.       INTEGER DIR(NFISH), YTURN(NFISH), YCOUNT(NFISH)
  164.  
  165.       DATA FISH /   2,   2,   3,   4,   4,   1,   1,   6,   5,   3,   4/
  166.       DATA X    /-100,-150,-450,-140,-200, 520, 620,-800, 800, 800,-300/
  167.       DATA Y    /  40,  60, 150,  80,  70, 190, 180, 100,  30, 130,  92/
  168.  
  169.       DATA XMIN /-300,-300,-800,-200,-200,-200,-300,-900,-900,-900,-400/
  170.       DATA XMAX / 600, 600,1100,1000,1000, 750, 800,1200,1400,1200, 900/
  171.       DATA XINC /   2,   2,   8,   5,   5,  -3,  -3,   7,  -8,  -9,   6/
  172.       DATA DIR  /   0,   0,   0,   0,   0,   1,   1,   0,   1,   1,   0/
  173.  
  174.       DATA YMIN /  40,  60, 120,  70,  60, 160, 160,  80,  30, 110,  72/
  175.       DATA YMAX /  80, 100, 170, 110, 100, 199, 199, 120,  70, 150, 122/
  176.       DATA YTURN/  50,  30,  10,  30,  20,  10,  10,  10,  30,   20, 10/
  177.       DATA YCOUNT/  0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0/
  178.       DATA YINC /   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0/
  179.  
  180. C *** make the fish swim around
  181.  
  182. 10    CONTINUE
  183.  
  184. C *** copy the background from page 2 to page 1
  185.  
  186.       CALL FG_COPYPAGE(2,1)
  187.  
  188. C *** put all the fish on the background
  189.  
  190.       DO 20 I = 1,11
  191.  
  192.          CALL FG_SETPAGE(1)
  193.          YCOUNT(I) = YCOUNT(I) + 1
  194.          IF (YCOUNT(I) .GT. YTURN(I)) THEN
  195.             YCOUNT(I) = 0
  196.             YINC(I) = IRANDOM(-1,1)
  197.          END IF
  198.          Y(I) = Y(I) + YINC(I)
  199.          Y(I) = MIN(YMAX(I),MAX(Y(I),YMIN(I)))
  200.  
  201.          IF (X(I) .GE. 0 .AND. X(I) .LT. 320) THEN
  202.             CALL PUT_FISH(FISH(I),X(I),Y(I),DIR(I))
  203.          ELSE IF (X(I) .LT. 0 .AND. X(I) .GT. -72) THEN
  204.             CALL FG_TRANSFER(0,71,0,199,104,199,1,3)
  205.             CALL FG_SETPAGE(3)
  206.             CALL PUT_FISH(FISH(I),X(I)+104,Y(I),DIR(I))
  207.             CALL FG_TRANSFER(104,175,0,199,0,199,3,1)
  208.          END IF
  209.          X(I) = X(I) + XINC(I)
  210.          IF (X(I) .LE. XMIN(I) .OR. X(I) .GE. XMAX(I)) THEN
  211.             XINC(I) = -XINC(I)
  212.             DIR(I) = 1 - DIR(I)
  213.          END IF
  214.  
  215. 20    CONTINUE
  216.  
  217. C *** copy page 1 to page 0
  218.  
  219.       CALL FG_SETPAGE(0)
  220.       CALL FG_COPYPAGE(1,0)
  221.  
  222. C *** intercept a keystroke, if it is escape exit the program
  223.  
  224.       CALL FG_INTKEY(KEY,AUX)
  225.       IF (KEY .NE. 27) GO TO 10
  226.  
  227.       RETURN
  228.       END
  229.  
  230. C************************************************************************
  231. C*                                                                      *
  232. C*                irandom -- random number generator                    *
  233. C*                                                                      *
  234. C************************************************************************
  235.  
  236.       FUNCTION IRANDOM(MIN,MAX)
  237.       IMPLICIT INTEGER (A-Z)
  238.  
  239.       TEMP = IEOR(SEED,ISHFT(SEED,-7))
  240.       SEED = IAND(IEOR(ISHFT(TEMP,8),TEMP),#7FFF)
  241.       IRANDOM = MOD(SEED,MAX-MIN+1) + MIN
  242.  
  243.       RETURN
  244.       END
  245.  
  246. C************************************************************************
  247. C*                                                                      *
  248. C*      put_fish -- draw one of the six fish anywhere you want          *
  249. C*                                                                      *
  250. C************************************************************************
  251.  
  252.       SUBROUTINE PUT_FISH(FISH_NUM,X,Y,FISH_DIR)
  253.       IMPLICIT INTEGER (A-Z)
  254.  
  255.       INTEGER*1 FISHES
  256.       COMMON /MAPS/ FISHES(5356), OFFSET(6)
  257.       COMMON /SIZE/ FISH_X1(6), FISH_Y1(6), WIDTH(6), HEIGHT(6)
  258.  
  259. C *** move to position where the fish will appear
  260.  
  261.       CALL FG_MOVE(X,Y)
  262.  
  263. C *** draw a left- or right-facing fish, depending on fish_dir
  264.  
  265.       I = OFFSET(FISH_NUM)
  266.       IF (FISH_DIR .EQ. 0) THEN
  267.          CALL FG_FLPIMAGE(FISHES(I),WIDTH(FISH_NUM),HEIGHT(FISH_NUM))
  268.       ELSE
  269.          CALL FG_CLPIMAGE(FISHES(I),WIDTH(FISH_NUM),HEIGHT(FISH_NUM))
  270.       END IF
  271.  
  272.       RETURN
  273.       END
  274.  
  275. C************************************************************************
  276. C*                                                                      *
  277. C*       randomize -- get a seed for the random number generator        *
  278. C*                                                                      *
  279. C************************************************************************
  280.  
  281.       SUBROUTINE RANDOMIZE
  282.       IMPLICIT INTEGER (A-Z)
  283.  
  284.       COMMON /SEED/ SEED
  285.  
  286.       INTEGER*4 FG_GETCLOCK
  287.  
  288.       SEED = IAND(INT(FG_GETCLOCK()),#7FFF)
  289.  
  290.       RETURN
  291.       END
  292.  
  293. C************************************************************************
  294. C*                                                                      *
  295. C*      block data -- initialize arrays in common blocks                *
  296. C*                                                                      *
  297. C************************************************************************
  298.  
  299.       BLOCK DATA
  300.       IMPLICIT INTEGER (A-Z)
  301.  
  302.       COMMON /SIZE/ FISH_X1(6), FISH_Y1(6), WIDTH(6), HEIGHT(6)
  303.       DATA FISH_X1 /  0, 64,128,200,  0, 80/
  304.       DATA FISH_Y1 /199,199,199,199,150,150/
  305.       DATA WIDTH   / 28, 27, 34, 28, 31, 34/
  306.       DATA HEIGHT  / 25, 38, 26, 30, 22, 36/
  307.  
  308.       END
  309.