home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgLangD.iso / FORTRAN / DISK6 / GRAPHIC.FO$ / GRAPHIC.bin
Text File  |  1989-01-16  |  2KB  |  76 lines
  1. CC  GRAPHIC.FOR - Displays every graphics mode.
  2.  
  3.       INCLUDE  'FGRAPH.FI'
  4.       INCLUDE  'FGRAPH.FD'
  5.  
  6.       INTEGER*2 key
  7.       EXTERNAL  printmenu
  8.       EXTERNAL  showmode
  9.  
  10.       CALL printmenu( key )
  11.       DO WHILE( key .NE. 0 )
  12.          CALL showmode( key )
  13.       END DO
  14.       END
  15.  
  16.  
  17.  
  18.       SUBROUTINE printmenu( key )
  19.  
  20.       INCLUDE  'FGRAPH.FD'
  21.  
  22.       INTEGER*2  dummy, key
  23.  
  24.       key = -1
  25.       DO WHILE( (key .LT. 0)  .OR.  (key .GT. 12) )
  26.          dummy = setvideomode( $DEFAULTMODE )
  27.          WRITE (*, 9000)
  28.          READ (*,*) key
  29.       END DO
  30.  
  31.  9000 FORMAT( ' Please ENTER a graphics mode.' /
  32.      +        ' (To exit, ENTER 0.)' /// '  0 Exit'  /
  33.      +        '  1 MRES4COLOR'   / '  2 MRESNOCOLOR' / 
  34.      +        '  3 HRESBW'       / '  4 HERCMONO'    / 
  35.      +        '  5 MRES16COLOR'  / '  6 HRES16COLOR' / 
  36.      +        '  7 ERESNOCOLOR'  / '  8 ERESCOLOR'   / 
  37.      +        '  9 VRES2COLOR'   / ' 10 VRES16COLOR' / 
  38.      +        ' 11 MRES256COLOR' / ' 12 ORESCOLOR'   / )
  39.  
  40.       END
  41.  
  42.  
  43.       SUBROUTINE showmode( which )
  44.  
  45.       INCLUDE  'FGRAPH.FD'
  46.  
  47.       INTEGER*2 which, dummy, i, height, width
  48.       INTEGER*2 modes(12) /
  49.      +         $MRES4COLOR , $MRESNOCOLOR, $HRESBW      , $HERCMONO  ,
  50.      +         $MRES16COLOR, $HRES16COLOR, $ERESNOCOLOR , $ERESCOLOR ,
  51.      +         $VRES2COLOR , $VRES16COLOR, $MRES256COLOR, $ORESCOLOR /
  52.  
  53.       RECORD /videoconfig/ screen
  54.  
  55.       IF( setvideomode( modes(which) ) .NE. 0 ) THEN
  56.          CALL getvideoconfig( screen )
  57.          width  = screen.numxpixels / screen.numcolors
  58.          height = screen.numypixels / 2
  59.          DO i = 0, screen.numcolors - 1
  60.             dummy = setcolor( INT4( i ) )
  61.             dummy = rectangle( $GFILLINTERIOR, i * width, 0,
  62.      +                       ( i + 1 ) * width, height )
  63.          END DO
  64.       ELSE
  65.          WRITE (*, 9000)
  66.       END IF
  67.  
  68.       READ (*,*)       ! Wait for ENTER key to be pressed
  69.       dummy = setvideomode( $DEFAULTMODE )
  70.       CALL printmenu( which )
  71.  
  72.  9000 FORMAT ( ' Video mode is not available.' /
  73.      +         ' Please press ENTER.   ' \ )
  74.  
  75.       END
  76.