jawsall.f

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

$alias fdopen='fdopen'(%val,%ref)
      include 'phigs.f1.h'			! get the HP-PHIGS aliases
      program Jaws2				! file "Jaws2.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
      real	CtrlPtsX(13), CtrlPtsY(13)	! control points for curve
      real	CtrlPtsZ(13), CtrlPtsW(13)	! zeroes for 2D curve
      data	CtrlPtsX /.1,.7,.9,.9,.7,.6,.55,.5,.2,.12,.1,.07,.1/
      data	CtrlPtsY /.1,.1,.1,.3,.3,.3,.25,.2,.2,.2 ,.3,.2 ,.1/
      data	CtrlPtsZ /0.,0.,0.,0.,0.,0.,0., 0.,0.,0. ,0.,0., 0./
      data	CtrlPtsW /0.,0.,0.,0.,0.,0.,0., 0.,0.,0. ,0.,0., 0./
      real	KnotVector(16)			! knot vector for curve
      data	KnotVector /0., 0., 0., 1., 2., 3., 4., 4., 5., 5.,
     +          6., 7., 7., 8., 8., 8./
      real	ParmRange(2)			! limits of parameter range
      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(1)				! open display list structure
      call psmk(PAST)				! set marker type to asterisk
      call psmksc(4.0)				! set marker scale factor
      call ppm(13, CtrlPtsX, CtrlPtsY)		! polymarker
      ParmRange(1)=0.0
      ParmRange(2)=8.0
      call pbsc3(3, 16, KnotVector, ParmRange,	! non-uniform b-spline curve
     +  PNRAT, 13, CtrlPtsX, CtrlPtsY, CtrlPtsZ, CtrlPtsW)
      call pclst				! close display list structure
      call ppost(WorkstnID, 1, 1.)		! send picture to display
      call pclwk(WorkstnID)			! close workstation
      call pclph				! close phigs
      stop					! stop processing
      end					! end of program