home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / basic / PGL.ZIP / PGLFS.ZIP / GEOM.FOR < prev    next >
Encoding:
Text File  |  1992-01-20  |  2.7 KB  |  87 lines
  1. C*****************************************************************************
  2. C  GEOM.FOR
  3. C
  4. C  This sample program demonstrates the use of the Device Info Functions.
  5. C****************************************************************************
  6.       include   "pgl.for"
  7.       integer*2 j, ierr, pdata(12), polydata(12)
  8.       data polydata/500,200, 100,400, 300,800,
  9.      +              600,600, 900,700, 750,300/
  10. C    
  11. C    Open A Drawing File.
  12. C    
  13.     call pgInitDrw( "GEOM.PLT"//CHAR(0), 3001, 3001, ierr) 
  14.       if( ierr .ne. 0)then
  15.          print *, 'Error opening drawing file!'
  16.          stop
  17.       endif
  18.  
  19.       call pgSetTextStyle( pgTRIPLEX ) 
  20.       call pgSetTextJustify( pgCENTER, pgBOTTOM ) 
  21.       call pgSetCharSpacing( 3 )
  22.       call pgSetTextScaling( 2,1,2,1 ) 
  23.       call pgSetColor( 15 )
  24. C
  25.       call pgRectangle( 0, 0, 3000, 3000, pgOUTLINE ) 
  26.       call pgLine( 0, 1000, 3000, 1000 ) 
  27.       call pgLine( 0, 2000, 3000, 2000 ) 
  28.       call pgLine( 1000, 0, 1000, 3000 ) 
  29.       call pgLine( 2000, 0, 2000, 3000 ) 
  30.  
  31. C-------- 1 
  32.       call pgArc( 500, 500, 300, 0, 210 ) 
  33.       call pgDrawTextXY( 500, 990, "ARC"//CHAR(0)) 
  34.  
  35. C-------- 2 
  36.       call pgSetFillStyle( 2, 1 ) 
  37.       call pgCircle( 1500, 500, 300, pgOFILL ) 
  38.       call pgDrawTextXY( 1500, 990, "CIRCLE"//CHAR(0)) 
  39.  
  40. C-------- 3 
  41.       call pgEllArc( 2500, 500, 400, 300, 0, 210 ) 
  42.       call pgDrawTextXY( 2500, 990, "ELLARC"//CHAR(0)) 
  43.  
  44. C------- 4 
  45.       call pgSetFillStyle( 3, 1 ) 
  46.       call pgEllipse( 500, 1500, 400, 300, pgOFILL ) 
  47.       call pgDrawTextXY( 500, 1990, "ELLIPSE"//CHAR(0)) 
  48.  
  49. C------- 5 
  50.       call pgSetFillStyle( 4, 1 ) 
  51.       call pgPie( 1500, 1500, 300, 0, 240, pgOFILL ) 
  52.       call pgDrawTextXY( 1500, 1990, "PIE"//CHAR(0)) 
  53.  
  54. C------- 6 
  55.       do j = 1,12,2
  56.         pdata(j)   = polydata(j)   + 2000 
  57.         pdata(j+1) = polydata(j+1) + 1000 
  58.       enddo
  59.       call pgSetFillStyle( 5, 1 ) 
  60.       call pgPolyLine( pdata, 6 ) 
  61.       call pgDrawTextXY( 2500, 1990, "POLYLINE"//CHAR(0)) 
  62.  
  63. C------- 7 
  64.       do j = 1,12,2
  65.         pdata(j)   = polydata(j)   + 0 
  66.         pdata(j+1) = polydata(j+1) + 2000 
  67.       enddo
  68.       call pgSetFillStyle( 6, 1 ) 
  69.       call pgPolygon( pdata, 6, pgOFILL ) 
  70.       call pgDrawTextXY( 500, 2990, "POLYGON"//CHAR(0)) 
  71.  
  72. C-------- 8 
  73.       call pgSetFillStyle( 7, 1 ) 
  74.       call pgRectangle( 1500-400, 2500-300, 1500+400, 2500+300,pgOFILL) 
  75.       call pgDrawTextXY( 1500, 2990, "RECTANGLE"//CHAR(0)) 
  76.  
  77. C-------- 9 
  78.       call pgSetFillStyle( 8, 1 ) 
  79.       call pgSector( 2500, 2500, 400, 300, 0, 300, pgOFILL ) 
  80.       call pgDrawTextXY( 2500, 2990, "SECTOR"//CHAR(0)) 
  81. C
  82. C      Close The Drawing File.
  83. C    
  84.       call pgEndDrw() 
  85. C
  86.       END
  87.