home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l291 / 6.ddi / SAMPLER.FO$ / SAMPLER.bin
Encoding:
Text File  |  1989-01-19  |  2.3 KB  |  78 lines
  1. CC  SAMPLER.FOR - Displays sample text in various fonts.
  2. CC
  3.  
  4.       INCLUDE  'FGRAPH.FI'
  5.       INCLUDE  'FGRAPH.FD'
  6.  
  7.       INTEGER*2            NFONTS
  8.       INTEGER*2            dummy, i, iend
  9.       CHARACTER*30         list
  10.       CHARACTER*64         fontpath
  11.       RECORD /videoconfig/ vc
  12.       RECORD /xycoord/     xy
  13.  
  14.       PARAMETER ( NFONTS   = 6 )
  15.  
  16.       CHARACTER*( 7 )  text(2 * NFONTS) /
  17.      +                 "COURIER",      "courier",
  18.      +                 "HELV"   ,      "helv"   ,
  19.      +                 "TMS RMN",      "tms rmn",
  20.      +                 "MODERN" ,      "modern" ,
  21.      +                 "SCRIPT" ,      "script" ,
  22.      +                 "ROMAN"  ,      "roman"  /
  23.  
  24.       CHARACTER*( 10 ) option(NFONTS) /
  25.      +                 "t'courier'",   "t'helv'"  ,
  26.      +                 "t'tms rmn'",   "t'modern'",
  27.      +                 "t'script'" ,   "t'roman'" /
  28.  
  29. C
  30. C     Locate .FON files, then register fonts by reading header
  31. C     information from all files.
  32. C
  33.       IF( registerfonts( '*.FON' ). LT. 0 ) THEN
  34.          WRITE (*, '(A/)') ' Enter directory for .FON files:'
  35.          READ  (*, '(A )') fontpath
  36.          iend = INDEX( fontpath, ' ' )
  37.          fontpath(iend:iend + 5) = '\*.FON'
  38.          IF( registerfonts( fontpath ). LT. 0 )
  39.      +       STOP 'Error:  cannot find font files'
  40.       ENDIF
  41.  
  42. C
  43. C     Find graphics mode.
  44. C
  45.       IF( setvideomode( $MAXRESMODE ) .EQ. 0 )
  46.      +   STOP 'Error:  cannot set graphics mode'
  47.  
  48. C
  49. C     Copy video configuration into structure vc.
  50. C
  51.       CALL getvideoconfig( vc )
  52.  
  53. C
  54. C     Display six lines of sample text.
  55. C
  56.       DO i = 1, NFONTS
  57.          list = option(i) // 'h30w24b'
  58.          IF( setfont( list ) .EQ. 0 ) THEN
  59.             dummy = setcolor( INT4( i ) )
  60.             CALL moveto( 0, (i - 1) * vc.numypixels / NFONTS, xy )
  61.             CALL outgtext( text((i * 2) - 1) )
  62.             CALL moveto( vc.numxpixels/2,
  63.      +                   (i - 1) * vc.numypixels / NFONTS, xy )
  64.             CALL outgtext( text(i * 2) )
  65.          ELSE
  66.             dummy = setvideomode( $DEFAULTMODE )
  67.             STOP 'Error:  cannot set font'
  68.          END IF
  69.       END DO
  70.  
  71.       READ (*,*)
  72.       dummy = setvideomode( $DEFAULTMODE )
  73. C
  74. C     Return memory when finished with fonts.
  75. C
  76.       CALL unregisterfonts()
  77.       END
  78.