fillareaset.f

来自「Intro/: Directory containing introducto」· F 代码 · 共 34 行

$alias fdopen='fdopen'(%val,%ref)
      include 'phigs.f1.h'			! get the HP-PHIGS aliases
      program FillAreaSet			! program "FillAreaSet.f"
      include 'phigs.f2.h'			! get the HP-PHIGS constants

      integer*4	WorkstnID			! workstation identifier
      parameter (WorkstnID=1)			! value chosen by the user
      integer*4	ConnID				! connection identifier
      integer*4	WorkstnType			! workstation type
      parameter (WorkstnType=POIDDX)		! out/in, direct, dbl bfr, X
      integer*4	TheStructure			! display list structure root
      parameter (TheStructure=1)		! value chosen by the user
      real	X(12), Y(12)			! arrays for filled areas
      data	X /.1,.9,.9,.1, .2,.4,.4,.2, .6,.8,.8,.6/	! X values
      data	Y /.2,.2,.8,.8, .3,.3,.7,.7, .3,.3,.7,.7/	! Y values
      integer*4 LastVerts(3)			! last vtx in each polygon
      data	LastVerts /4, 8, 12/
      integer*4 fdopen				! to get file descriptor

      call popph(fdopen(fnum(7), 'w'//char(0)), 0)	! open phigs
      call pue004('/dev/screen/phigs_window', ConnID)	! get connection ID
      call popwk(WorkstnID, ConnID, WorkstnType)! open workstation
      call popst(TheStructure)			! open display list structure
      call psis(PHATCH)				! set interior style
      call psedfg(PON)				! set edge flag
      call pfas(3, LastVerts, X, Y)		! fill area set
      call pclst				! close display list structure
      call ppost(WorkstnID, TheStructure, 1.)	! mark structure for display
      call puwk(WorkstnID, PPERFO)		! update the workstation
      call pclwk(WorkstnID)			! close workstation
      call pclph				! close phigs
      stop					! stop processing
      end					! end of program