local.f

Intro/: Directory containing introductory examples. HelloWorld.c A simple program that draws a bo

$alias fdopen='fdopen'(%val,%ref)
      include 'phigs.f1.h'			! get the HP-PHIGS aliases
      program Local				! file "Local.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(10), CtrlPtsY(10), CtrlPtsZ(10), CtrlPtsW(10)
      data	CtrlPtsX /.1, .1, .3, .2, .5, .3, .6, .7, .7, .9/
      data	CtrlPtsY /.1, .5, .8, .9, .9, .2, .0, .2, .7, .9/
      data	CtrlPtsZ /0., 0., 0., 0., 0., 0., 0., 0., 0., 0./
      data	CtrlPtsW /0., 0., 0., 0., 0., 0., 0., 0., 0., 0./
      real	KnotVector(13)			! number of knots needed
      integer*4	NumKnots			! number of knots in vector
      integer*4	NumSegs				! number of segments in curve
      real	ParmRange(2)			! limits of parameter range
      integer*4	I				! loop control variable
      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 MakeKnotVector(3, 10, KnotVector, NumKnots, NumSegs)
      ParmRange(1)=0.0
      ParmRange(2)=8.0
      do I=1,5
          CtrlPtsY(7)=I*.1			! change one control point
          call ppm(10, CtrlPtsX, CtrlPtsY)	! polymarker
          call pbsc3(3, NumKnots, KnotVector, ParmRange,! b-spline curve
     +      PNRAT, 10, CtrlPtsX, CtrlPtsY, CtrlPtsZ, CtrlPtsW)
      end do
      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
!***********************************************************************+*****
      subroutine MakeKnotVector(Order, NumCtrlPts, KnotVector, NumKnots,
     +  NumSegs)
      integer*4	Order				! order of the spline
      integer*4	NumCtrlPts			! number of ctrl pts in curve
      real	KnotVector(Order+NumCtrlPts)	! the returned knot vector
      integer*4	NumKnots			! number of knots in vector
      integer*4	NumSegs				! number of segments in curve
      
      integer*4	I				! loop control variable
      integer*4	Knot				! array index
      
      NumSegs=NumCtrlPts+1-Order		! calculate number of segments
      NumKnots=Order+NumCtrlPts			! calculate number of knots
      Knot=0					! initialize the index
      !--- define the multiples at the beginning of the knot vector ----------
      do I=1,Order				! initial multiples
          Knot=Knot+1				! increment index
          KnotVector(Knot)=0.			! define the element
      end do
      !--- define the middle chunk -------------------------------------------
      do I=1,NumSegs-1
          Knot=Knot+1				! increment index
          KnotVector(Knot)=real(I)		! define the element
      end do
      !--- define the multiples at the end of the knot vector ----------------
      do I=1,Order				! initial multiples
          Knot=Knot+1				! increment index
          KnotVector(Knot)=real(NumSegs)	! define the element
      end do
      return
      end