home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l291 / 6.ddi / CGAPAL.FO$ / CGAPAL.bin
Encoding:
Text File  |  1990-09-28  |  1.5 KB  |  53 lines
  1. CC  CGAPAL.FOR - Illustrates CGA palettes using:
  2. CC               selectpalette
  3.  
  4.       INCLUDE  'FGRAPH.FI'
  5.       INCLUDE  'FGRAPH.FD'
  6.  
  7.       INTEGER*2        status2
  8.       INTEGER*4        status4, bkcolor(8)
  9.       CHARACTER*7      bkname(8)
  10.       CHARACTER*40     str
  11.       RECORD /rccoord/ curpos
  12.  
  13.       DATA bkcolor / $BLACK , $BLUE    , $GREEN , $CYAN   ,
  14.      +               $RED   , $MAGENTA , $BROWN , $WHITE  /
  15.       DATA bkname  / 'BLACK', 'BLUE'   , 'GREEN', 'CYAN'  ,
  16.      +               'RED'  , 'MAGENTA', 'BROWN', 'WHITE' /
  17. C
  18. C     Set video mode.
  19. C
  20.       IF( setvideomode( $MRES4COLOR ) .EQ. 0 )
  21.      +    STOP 'Error:  cannot set CGA color mode'
  22. C
  23. C     Palette loop
  24. C
  25.       DO i = 0, 3
  26.          status2 = selectpalette( i )
  27. C
  28. C        Background color loop
  29. C
  30.          DO k = 1, 8
  31.             CALL clearscreen( $GCLEARSCREEN )
  32.             status4 = setbkcolor( bkcolor(k) )
  33.             CALL settextposition( 1, 1, curpos )
  34.             WRITE (str, 9000) bkname(k), i
  35.             CALL outtext( str )
  36. C
  37. C           Foreground color loop
  38. C
  39.             DO j = 1, 3
  40.                status2 = setcolor( INT4( j ) )
  41.                status2 = ellipse( $GFILLINTERIOR, 100, j * 30, 220,
  42.      +                           80 + (j * 30))
  43.             END DO
  44.             READ (*,*)    ! Wait for ENTER to be pressed
  45.          END DO
  46.       END DO
  47.  
  48.       status2 = setvideomode( $DEFAULTMODE )
  49.  
  50.  9000 FORMAT ('Background: ', A, 10x, 'Palette: ', I2)
  51.  
  52.       END 
  53.