orders.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 Orders				! file "Orders.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	Linear, Quadratic, Cubic, Quartic, Quintic
      parameter	(Linear=2, Quadratic=3, Cubic=4, Quartic=5, Quintic=6)
      character*17 OrderNames(5)		! names of the splines' orders
      data OrderNames /'', 'Linear/Quadratic', '  Linear/Cubic',
     +  ' Linear/Quartic', ' Linear/Quintic'/
      real	CtrlPtsX(7), CtrlPtsY(7), CtrlPtsZ(7), CtrlPtsW(7)
      data	CtrlPtsX /.1, .3, .4, .5, .6,  .8, .9/
      data	CtrlPtsY /.3, .9, .4, .6, .15, .2, .6/
      data	CtrlPtsZ /0., 0., 0., 0., 0.,  0., 0./
      data	CtrlPtsW /0., 0., 0., 0., 0.,  0., 0./
      real	KnotVector(13)			! maximum number needed
      integer*4	NumKnots			! number of knots in vector
      integer*4	NumSegs				! number of segments in curve
      real	Tlimits(2)			! parameter limits for spline
      real	Window(4), Viewport(4)		! sent to "pevmm"
      data	Window /0., 1., 0., 1./		! always 0-1, both directions
      real	Identity(3,3), ViewMapMat(3,3)	! transformation matrices
      data	Identity /1., 0., 0.,
     +			  0., 1., 0.,
     +			  0., 0., 1./
      integer*4	Quadrant, Order			! loop control variables
      integer*4 fdopen				! to get file descriptor
      integer*4	Error				! error-return variable
      integer*4	IBool				! forward reference

      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 pschh(.07)				! set character height
      call pschxp(.7)				! set char. expansion factor
      call pstxal(PACENT, PABOTT)		! set text alignment
      do Quadrant=1,4				! four images:	+---+---+
          Viewport(1)=IBool(mod(Quadrant,2).eq.0)*.5	!	| 1 | 2 |
          Viewport(2)=Viewport(1)+.5			!	+---+---+
          Viewport(3)=IBool(Quadrant.le.2)*.5		!	| 3 | 4 |
          Viewport(4)=Viewport(3)+.5			!	+---+---+
          call pevmm(Window, Viewport, Error, ViewMapMat) ! eval view map mat
          call psvwr(WorkstnID, Quadrant,	! set view representation
     +	    Identity, ViewMapMat, Viewport, PCLIP)
          call psvwi(Quadrant)			! set view index
          call MakeKnotVector(Linear, 7, KnotVector, NumKnots, NumSegs)
          Tlimits(1)=0.
          Tlimits(2)=real(NumSegs)
          call pbsc3(Linear, NumKnots, KnotVector,	! linear curve
     +      Tlimits, PNRAT, 7, CtrlPtsX, CtrlPtsY, CtrlPtsZ, CtrlPtsW)
          Order=Linear+Quadrant			! order of second curve
          call MakeKnotVector(Order, 7, KnotVector, NumKnots, NumSegs)
          Tlimits(1)=0.
          Tlimits(2)=real(NumSegs)
          call pbsc3(Order, NumKnots, KnotVector,	! higher-order curve
     +      Tlimits, PNRAT, 7, CtrlPtsX, CtrlPtsY, CtrlPtsZ, CtrlPtsW)
          call ptx(.5, .03, OrderNames(Quadrant+1))	! text label
      end do
      call pclst				! close display list structure
      call ppost(WorkstnID, 1, 1.)		! send picture to display
      call puwk(WorkstnID, PPERFO)		! update the workstation
      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
!*****************************************************************************
      integer*4 function IBool(State)		! convert logical value to...
      logical State				! ...integer to allow math ops
      
      if (State) then
          IBool=1
      else
	  IBool=0
      end if
      return
      end