home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgLangD.iso / Fortran.51 / DISK6 / CURSOR.FO$ / CURSOR.bin
Text File  |  1991-03-11  |  2KB  |  59 lines
  1. CC  CURSOR.FOR - Illustrates cursor functions including:
  2. CC               displaycursor  gettextcursor  settextcursor
  3.  
  4.       INCLUDE  'FGRAPH.FI'
  5.       INCLUDE  'FGRAPH.FD'
  6.  
  7.       INTEGER*2            status, oldcursor, newcursor,
  8.      +                     curs_start, curs_end, block
  9.       CHARACTER*40         str
  10.       RECORD /rccoord/     curpos
  11.       RECORD /videoconfig/ vc
  12.  
  13. C
  14. C     Save old cursor shape and make sure cursor is on.
  15. C
  16.  
  17.       CALL clearscreen( $GCLEARSCREEN )
  18.       oldcursor = gettextcursor()
  19.       status     = displaycursor( $GCURSORON )
  20.       CALL settextposition( 1, 1, curpos )
  21.       CALL outtext( 'Press ENTER to continue . . .' )
  22. C
  23. C     Change cursor shape.
  24. C     Cursor uses scan lines 0-7.
  25. C
  26.       CALL getvideoconfig( vc )
  27.       block = 7
  28.       curs_start = 0
  29.       DO curs_end = block, 0, -1
  30.          CALL settextposition( 10, 1, curpos )
  31.          WRITE (str, 9000) curs_start, curs_end
  32.          CALL outtext( str )
  33.          newcursor = (curs_start * 256) + curs_end
  34.          status     = settextcursor( newcursor )
  35.          READ (*,*)  ! Wait for ENTER to be pressed
  36.          curs_start = curs_start + 1
  37.       END DO
  38.  
  39.       WRITE (str, '(A13)') 'Cursor off:  '
  40.       CALL settextposition( 12, 1, curpos )
  41.       CALL outtext( str )
  42.       status = displaycursor( $GCURSOROFF )
  43.       READ (*,*)  ! Wait for ENTER to be pressed
  44.       WRITE (str, '(A13)') 'Cursor on :  '
  45.       CALL settextposition( 13, 1, curpos )
  46.       CALL outtext( str )
  47.       status = settextcursor( block )
  48.       status = displaycursor( $GCURSORON )
  49.       READ (*,*)  ! Wait for ENTER to be pressed
  50. C
  51. C     Restore original cursor shape.
  52. C
  53.       status = settextcursor( oldcursor )
  54.       CALL clearscreen( $GCLEARSCREEN )
  55.  
  56.  9000 FORMAT ( 'Start line:', I4, 8x, 'Endline:', I4, 3x )
  57.  
  58.       END
  59.