wiremesh.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 WireMesh				! program "WireMesh.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, sngl bfr, X
      real	CtrlPtsX(12),CtrlPtsY(12),CtrlPtsZ(12)	! control points
      data	CtrlPtsX /.0,.5,1., .0,.5,1., .0,.5,1., .0,.5,1./
      data	CtrlPtsY /.0,.3,.2, .1,.5,.4, .3,.4,.1, .0,.2,.3/
      data	CtrlPtsZ /.0,.0,.0, .3,.3,.3, .6,.6,.6, .9,.9,.9/
      real	uKnotVector(6), vKnotVector(8)	! knot vectors
      data	uKnotVector /0., 0., 0., 1., 1., 1./
      data	vKnotVector /0., 0., 0., 0., 1., 1., 1., 1./
      real	StepSizeData(4)			! sent to "pprec"
      data	StepSizeData /.1, .1, .1, .1/	! u, v exterior; u, v interior
      integer*4	TheMesh, MeshLabel		! structure identifier, label
      parameter (TheMesh=1, MeshLabel=1)	! values chosen by the user
      real	ThetaMin,ThetaMax, dTheta, Theta! loop control variables
      parameter (ThetaMin=0., ThetaMax=410., dTheta=.4)
      real	xform(4,4)			! transformation matrix
      integer*4	Error				! error-return variable
      character*80 DataRec(10)			! sent to "pprec"
      integer*4	DataRecLen			! ditto
      integer*4	Dummy(1)			! dummy variable
      integer*4	u, v				! loop control variables
      integer*4	I, Iu, Iv			! temporary array indexes
      integer*4 fdopen				! to get file descriptor

      real	rad, deg			! type the statement function
      rad(deg)=	((deg)*3.14159265358979/180.)	! convert degrees to radians

      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 ppost(WorkstnID, TheMesh, 1.)	! mark structure for display
      !=== define the spline-generating structure ============================
      call popst(TheMesh)			! open structure
      !--- set up transformations --------------------------------------------
      call ptr3(-.5, .0, -.5, Error, xform)	! 3d translate: to origin
      call pslmt3(xform, PCREPL)		! set local transformation
      call psc3(.7, .7, .7, Error, xform)	! 3d scale to 70%
      call pslmt3(xform, PCPOST)		! set local transformation
      call prox(rad(30), Error, xform)		! rotate about X axis
      call pslmt3(xform, PCPOST)		! set local transformation
      call proy(rad(0), Error, xform)		! rotate about Y axis
      call plb(MeshLabel)			! label
      call pslmt3(xform, PCPOST)		! set local transformation
      call ptr3(.5, .3, .5, Error, xform)	! 3d translate: into position
      call pslmt3(xform, PCPOST)		! set local transformation
      !--- delta t (independent variable) of 0.1 -----------------------------
      call pprec(0, Dummy, 4, StepSizeData,	! pack data record
     +	0, 0, '', 10, Error, DataRecLen, DataRec)
      if (Error .ne. 0) then
          print *,"Error", Error, "in pprec."
          stop
      end if
      call pssac(-3, DataRecLen, DataRec)	! set surface approx. criteria
      !--- define the b-spline surface ---------------------------------------
      call pspsc(PIEPC, 0, Dummy)		! set parametric surface char.
      call pbss3(				! non-uniform b-spline surface
     +	3, 4,					!   u, v order
     +	6, 8,					!   u, v knots
     +	uKnotVector, vKnotVector,		!   u, v knot vectors
     +	PNRAT,					!   non-rational surface
     +	3, 4,					!   u, v control points
     +	CtrlPtsX, CtrlPtsY, CtrlPtsZ,		!   control points' XYZs
     +	Dummy,					!   dummy homogeneous coords
     +	0, Dummy)				!   no trimming curves
      !--- draw control-point grid -------------------------------------------
      call psln(PLDOT)				! set line type
      do u=1, 3
          do v=1, 4
              I=(v-1)*3+u			! index of X(u,v)
              Iu=(v-1)*3+u+1			! index of X(u+1,v)
              Iv=v*3+u				! index of X(u,v+1)
              if (u .lt. 3)			! unless on right edge...
     +          call Line(CtrlPtsX(I), CtrlPtsY(I), CtrlPtsZ(I),
     +          CtrlPtsX(Iu), CtrlPtsY(Iu), CtrlPtsZ(Iu))
              if (v .lt. 4)			! unless on bottom edge...
     +          call Line(CtrlPtsX(I), CtrlPtsY(I), CtrlPtsZ(I),
     +          CtrlPtsX(Iv), CtrlPtsY(Iv), CtrlPtsZ(Iv))
          end do
      end do
      call pclst				! close structure
      !=== rotate the spline surface =========================================
      Theta=ThetaMin				! initialize loop control var.
      do while (Theta .lt. ThetaMax)		! for each angle...
          call popst(TheMesh)			! open structure
          call proy(rad(Theta), Error, xform)	! rotate about Y axis
          call psep(1)				! set element pointer: BOS
          call pseplb(MeshLabel)		! set element pointer at label
          call posep(1)				! offset element pointer: +1
          call psedm(PREPLC)			! set edit mode
          call pslmt3(xform, PCPOST)		! set local transformation
          call pclst				! close structure
          call puwk(WorkstnID, PPERFO)		! update the workstation
          Theta=Theta+dTheta			! increment angle
      end do
      call pclwk(WorkstnID)			! close workstation
      call pclph				! close phigs
      stop					! stop processing
      end					! end of program
!*****************************************************************************
      subroutine Line(X1, Y1, Z1, X2, Y2, Z2)
      real	X1, Y1, Z1, X2, Y2, Z2		! "from" point, "to" point
      
      real	X(2), Y(2), Z(2)		! for 3D polyline
      
      X(1)=X1					! \
      Y(1)=Y1					!  \
      Z(1)=Z1					!   \ put the individual
      X(2)=X2					!   / values into the arrays
      Y(2)=Y2					!  /
      Z(2)=Z2					! /
      call ppl3(2, X, Y, Z)			! polyline 3D
      return
      end