surface.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 Surface				! program "Surface.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
      integer*4	LightsOn(2)			! sent to "pslss"
      data	LightsOn /1, 2/			! turn both lights on
      real	Gray(3)				! define RGB triple
      data	Gray /0.5, 0.5, 0.5/		! RGB for 50% gray
      real	ThetaMin,ThetaMax, dTheta, Theta! loop control variables
      parameter (ThetaMin=0., ThetaMax=770., dTheta=.5)
      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 pue250(WorkstnID, 0)			! set colour env.: Direct
      call pshrm(WorkstnID, PHRZBF)		! set HLHSR mode
      call DefineLightSource(WorkstnID, 1,PAMB,	! light source 1: ambient
     +	0.4, 0.4, 0.4,				!   colour: gray
     +	0.0, 0.0, 0.0,				!   location (unused)
     +  0.0, 0.0, 0.0,				!   direction (unused)
     +  0.0, 0.0, 0.0, 0.0)			!   conc/spread/atten (unused)
      call DefineLightSource(WorkstnID, 2,PDIRE,! light source 2: directional
     +	0.4, 0.4, 0.4,				!   colour: gray
     +  0.0, 0.0, 0.0,				!   location: (unused)
     +	5.0, 2.0, 7.0,				!   direction: right shoulder
     +  0.0, 0.0, 0.0, 0.0)			!   conc/spread/atten (unused)
      call ppost(WorkstnID, TheMesh, 1.)	! mark structure for display
      !=== define the spline-generating structure ============================
      call popst(TheMesh)			! open structure
      call pslss(2, LightsOn, 0, Dummy)		! set light source state
      call psrfm(PADSRM)			! set reflectance model
      !--- set up transformations --------------------------------------------
      call ptr3(-0.5, 0.0, -0.5, Error, xform)	! 3D translate: to origin
      call pslmt3(xform, PCREPL)		! set local transformation
      call psc3(0.7, 0.7, 0.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(0.5, 0.3, 0.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(PSTSA, DataRecLen, DataRec)	! set surface approx. criteria
      !--- define the b-spline surface ---------------------------------------
      call psic(PRGB, 0, 3, Gray)		! set interior colour
      call psis(PSOLID)				! set interior style
      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 right 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 puwk(WorkstnID, PPERFO)
!      read *
      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
!*****************************************************************************
      subroutine DefineLightSource(WorkstnID, LightNo, LightType,
     +  R, G, B, X, Y, Z, dX, dY, dZ, Exponent, Spread, Att1, Att2)
      integer*4	WorkstnID		! workstation ID
      integer*4	LightNo, LightType	! index and type
      real	R, G, B			! colour
      real	X, Y, Z			! position (positional)
      real	dX, dY, dZ		! direction (all but ambient)
      real	Exponent		! concentration exponent (spot)
      real	Spread			! spread angle (spot)
      real	Att1, Att2		! attenuation factors (pos., spot)
      include '/usr/include/phigs.f2.h'

      !--- Variables for packing data record ---------------------------------
      integer*4		IntCount	! DataRec's integer count
      integer*4		Ints(2)		! DataRec's integer array
      integer*4		RealCount	! DataRec's real count
      real		Reals(13)	! max needed for DataRec's real array
      integer*4		StrCount	! DataRec's string count
      integer*4		StrLength	! DataRec's string length
      character*1	Strings(1)	! DataRec's string array
      integer*4		RecCount	! DataRec's element count
      data		StrCount /0/, StrLength /0/, RecCount /8/
      integer*4		Length		! DataRec's element return length
      character*80	DataRec(8)	! DataRec array itself

      integer*4		Error		! error-return variable

      IntCount=2			! two significant integers in array
      Ints(1)=PRGB			! specify colour as RGB
      Ints(2)=3				! RGBs have 3 components
      if (LightType .eq. PAMB) then	! if ambient light...
	  RealCount=3			! three significant reals in array
	  Reals(1)=R			! \
	  Reals(2)=G			!  > set ambient light's colour
	  Reals(3)=B			! /
      endif
      if (LightType .eq. PDIRE) then	! if directional light...
	  RealCount=6			! six significant reals in array
	  Reals(1)=dX			! \
	  Reals(2)=dY			!  > set light's direction
	  Reals(3)=dZ			! /
	  Reals(4)=R			! \
	  Reals(5)=G			!  > set directional light's colour
	  Reals(6)=B			! /
      endif
      if (LightType .eq. PPOSI) then	! if positional light...
	  RealCount=8			! eight significant reals in array
	  Reals(1)=X			! \
	  Reals(2)=Y			!  > set light's position
	  Reals(3)=Z			! /
	  Reals(4)=Att1			! attenuation factor 1
	  Reals(5)=Att2			! attenuation factor 2
	  Reals(6)=R			! \
	  Reals(7)=G			!  > set positional light's colour
	  Reals(8)=B			! /
      endif
      if (LightType .eq. PSPOT) then	! if spotlight...
	  RealCount=13			! thirteen significant reals in array
	  Reals(1)=X			! \
	  Reals(2)=Y			!  > set light's position
	  Reals(3)=Z			! /
	  Reals(4)=dX			! \
	  Reals(5)=dY			!  > set light's direction
	  Reals(6)=dZ			! /
	  Reals(7)=Exponent		! concentration exponent
	  Reals(8)=Att1			! attenuation factor 1
	  Reals(9)=Att2			! attenuation factor 2
	  Reals(10)=Spread		! spread angle
	  Reals(11)=R			! \
	  Reals(12)=G			!  > set positional light's colour
	  Reals(13)=B			! /
      endif
      call pprec(IntCount, Ints, RealCount, Reals, StrCount, StrLength,
     +  Strings, RecCount, Error, Length, DataRec)
      if (Error .ne. 0) print *, "Error", Error, " in pprec."
      call pslsr(WorkstnID, LightNo,	! set light source representation
     +  LightType, Length, DataRec)
      return
      end