home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgLangD.iso / Fortran.51 / DISK6 / PAGE.FO$ / PAGE.bin
Text File  |  1991-03-11  |  2KB  |  76 lines
  1. CC    PAGE.FOR - Illustrates animation effects by changing the video page.
  2. CC             The video page functions demonstrated include:
  3. CC             getactivepage  getvisualpage  setactivepage  setvisualpage
  4.  
  5.       INCLUDE  'FGRAPH.FI'
  6.       INCLUDE  'FGRAPH.FD'
  7.  
  8.       INTEGER*2        error, oldapage, oldvpage
  9.       INTEGER*2        i, j, k, l
  10.       CHARACTER*3      jumper(4,3)
  11.       RECORD /rccoord/ curpos
  12.  
  13.       DATA jumper / '\o/', '_o_', ' o ', ' o ',
  14.      +              ' O ', ' O ', '/O\', ' O ',
  15.      +              '/ \', '( )', '/ \', '( )' /
  16.  
  17.       oldapage  = getactivepage()
  18.       oldvpage  = getvisualpage()
  19.       IF( setvideomode( $TEXTBW40 ) .EQ. 0 )
  20.      +    STOP 'Error:  cannot set 40-column mode'
  21.       error     = displaycursor( $GCURSOROFF )
  22.  
  23. C
  24. C     Draw 24 images on each page.
  25. C
  26.       DO i = 1, 4
  27.          error = setactivepage( i - 1 )
  28.          DO j = 1, 22, 7
  29.             DO k = 1, 36, 7
  30.                DO l = 0, 2
  31.  
  32.                   CALL settextposition( j + l, k, curpos )
  33.                   CALL outtext( jumper(i,l + 1) )
  34.                END DO
  35.             END DO
  36.          END DO
  37.       END DO
  38.  
  39. C
  40. C     Cycle 10 times through pages 0-3.
  41. C
  42.       DO i = 1, 10
  43.          DO j = 0, 3
  44.             error = setvisualpage( j )
  45.             CALL delay( INT2( 10 ) )
  46.          END DO
  47.       END DO
  48.  
  49. C
  50. C     Restore original page.
  51. C
  52.       error = setvideomode( $DEFAULTMODE )
  53.       error = setactivepage( oldapage )
  54.       error = setvisualpage( oldvpage )
  55.       END
  56.  
  57.  
  58. CC  DELAY - Pauses for a specified number of 1/100 seconds.
  59. CC
  60. CC  Params:  Wait - pause time in 0.01 seconds
  61.  
  62.       SUBROUTINE delay( wait )
  63.       INTEGER*2 wait, tick0, tick1, tick, kount, dummy
  64.  
  65.       kount = 0
  66.       CALL GETTIM( dummy, dummy, dummy, tick0 )
  67.       DO WHILE( kount .LT. wait )
  68.          CALL GETTIM( dummy, dummy, dummy, tick1 )
  69.          tick = tick1 - tick0
  70.          IF( tick .LT. 0 ) tick = tick + 100 
  71.          tick0 = tick1
  72.          kount = kount + tick
  73.       END DO
  74.       RETURN
  75.       END
  76.