triquadd.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 TriQuadD				! program "TriQuadD.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	Scene, Strip, Mesh		! structure IDs
      parameter	(Scene=1, Strip=2, Mesh=3)	! values chosen by user
      real	Red(3), White(3), Yellow(3)	! RGB holders
      data	Red	/1.0, 0.0, 0.0/		! RGB for red
      data	White	/1.0, 1.0, 1.0/		! RGB for white
      data	Yellow	/1.0, 1.0, 0.0/		! RGB for yellow
      integer*4	Error				! error-return variable
      integer*4 Dummy				! dummy (placeholder) 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 pue250(WorkstnID, 0)			! set colour env: direct
      call CreateMesh(Mesh)			! define quad mesh structure
      call CreateTriStrip(Strip)		! define tri strip structure
      call popst(Scene)				! open the scene structure 
      call psis(PSOLID)				! set interior style
      call psic(PRGB, Dummy, 3, Red)		! set interior color
      call psedfg(PON)				! set edge flag
      call psedc(PRGB, Dummy, 3, White)		! set edge color
      call pexst(Mesh)				! execute structure 
      call pexst(Strip)				! execute structure 
      call pclst				! close structure 
      call ppost(WorkstnID, Scene, 1.0)		! post structure 
      call prst(WorkstnID, PALWAY)		! redraw all structures 
      call puwk(WorkstnID, PPERFO)		! update workstation
      call pclwk(WorkstnID)			! close workstation
      call pclph				! close phigs
      stop					! stop processing
      end					! end of program
!*****************************************************************************
      subroutine CreateMesh(Mesh)
      integer*4 Mesh
      include '/usr/include/phigs.f2.h'

      real	QuadMeshX(10, 3), QuadMeshY(10, 3), QuadMeshZ(10, 3)
      real	FacetColrs(54)
      real	VertexColrs(90)
      real	Red(3), Yellow(3)		! RGB holders
      data	Red	/1.0, 0.0, 0.0/		! RGB for red
      data	Yellow	/1.0, 1.0, 0.0/		! RGB for yellow
      real	Xform(4,4)			! transformation matrix
      integer*4	Error				! error-return variable
      integer*4	I, J				! loop control variables
      integer*4 Dummy				! dummy (placeholder) variable

      !--- define the vertices for the quadrilateral mesh --------------------
      do I=0, 9
	  do J=0, 2
	      QuadMeshX(I+1, J+1)=I*.04
	      QuadMeshY(I+1, J+1)=.2-J*.1
	      QuadMeshZ(I+1, J+1)=.5
	  end do
      end do
      !--- define the facet colours for the quadrilateral mesh ---------------
      do I=0, 17
	  if (mod(mod(I, 9), 2) .eq. 1) then
	      do J=1, 3
		  FacetColrs(I*3+J)=Yellow(J)
	      end do
	  else
	      do J=1, 3
		  FacetColrs(I*3+J)=Red(J)
	      end do
	  end if
      end do
      !--- define the vertex colours for the quadrilateral mesh --------------
      do I=0, 89, 3
	  VertexColrs(I+1)=1.
	  if (I/30 .eq. 1) then
	      VertexColrs(I+2)=1.
	  else
	      VertexColrs(I+2)=0.
	  end if
	  VertexColrs(I+3)=0.
      end do
      !=== define the structure that does the quad meshes ====================
      call popst(Mesh)				! open structure
      !--- first: use interior colour ----------------------------------------
      call psism(PNOIS)				! set interior shading method
      call ptr3(.08, .76, 0., Error, Xform)	! translate 3
      call pslmt3(Xform, PCREPL)		! set local matrix 3
      call pqm3d(				! quad mesh 3D
     +	PFNO,					!   facet flag: none
     +	PENO,					!   edge flag: none
     +	PCD,					!   vertex flag: coords only
     +	PRGB, 3,				!   RGB has 3 coords
     +	3, 10,					!   columns, rows
     +	Dummy, Dummy,				!   facet colours
     +	Dummy, Dummy, Dummy,			!   facet normals
     +	Dummy, Dummy,				!   application data (facet)
     +	Dummy,					!   edge flags
     +	QuadMeshX, QuadMeshY, QuadMeshZ,	!   quad mesh's XYZ data
     +	Dummy, Dummy,				!   vertex colours
     +	Dummy, Dummy, Dummy,			!   vertex normals
     +	Dummy, Dummy)				!   application data (vertex)
      !--- second: use facet colour ------------------------------------------
      call ptr3(.52, .76, 0., Error, Xform)	! translate 3
      call pslmt3(Xform, PCREPL)		! set local matrix 3
      call pqm3d(				! quad mesh 3D
     +	PFC,					!   facet flag: colour
     +	PENO,					!   edge flag: none
     +	PCD,					!   vertex flag: coords only
     +	PRGB, 3,				!   RGB has 3 coords
     +	3, 10,					!   columns, rows
     +	Dummy, FacetColrs,			!   facet colours
     +	Dummy, Dummy, Dummy,			!   facet normals
     +	Dummy, Dummy,				!   application data (facet)
     +	Dummy,					!   edge flags
     +	QuadMeshX, QuadMeshY, QuadMeshZ,	!   quad mesh's XYZ data
     +	Dummy, Dummy,				!   vertex colours
     +	Dummy, Dummy, Dummy,			!   vertex normals
     +	Dummy, Dummy)				!   application data (vertex)
      !--- third: use vertex colour ------------------------------------------
      call psism(PCIS)				! set interior shading method
      call ptr3(.52, .53, 0., Error, Xform)	! translate 3
      call pslmt3(Xform, PCREPL)		! set local matrix 3
      call pqm3d(				! quad mesh 3D
     +	PFNO,					!   facet flag: none
     +	PENO,					!   edge flag: none
     +	PCDC,					!   vertex flag: coords/colour
     +	PRGB, 3,				!   RGB has 3 coords
     +	3, 10,					!   columns, rows
     +	Dummy, Dummy,				!   facet colours
     +	Dummy, Dummy, Dummy,			!   facet normals
     +	Dummy, Dummy,				!   application data (facet)
     +	Dummy,					!   edge flags
     +	QuadMeshX, QuadMeshY, QuadMeshZ,	!   quad mesh's XYZ data
     +	Dummy, VertexColrs,			!   vertex colours
     +	Dummy, Dummy, Dummy,			!   vertex normals
     +	Dummy, Dummy)				!   application data (vertex)
      call pclst				! close structure
      return
      end
!*****************************************************************************
      subroutine CreateTriStrip(Strip)
      integer*4 Strip
      include '/usr/include/phigs.f2.h'
      real	TriStrip1X(20), TriStrip1Y(20), TriStrip1Z(20)
      real	TriStrip2X(20), TriStrip2Y(20), TriStrip2Z(20)
      real	FacetColrs(54)
      real	VertexColrs1(60), VertexColrs2(60)
      real	Xform(4,4)			! transformation matrix
      real	Red(3), Yellow(3)		! RGB holders
      data	Red	/1.0, 0.0, 0.0/		! RGB for red
      data	Yellow	/1.0, 1.0, 0.0/		! RGB for yellow
      integer*4	Error				! error-return variable
      integer*4	I, J				! loop control variables
      integer*4	Dummy				! dummy (placeholder) variable

      !--- define the points for the triangle strips -------------------------
      do I=0, 19
	  TriStrip1X(I+1)=(I/2)*.04
	  TriStrip1Y(I+1)=(1-mod(I,2))*.1
	  TriStrip1Z(I+1)=.5
	  TriStrip2X(I+1)=TriStrip1X(I+1)
	  TriStrip2Y(I+1)=TriStrip1Y(I+1)+.1
	  TriStrip2Z(I+1)=.5
      end do
      !--- define the facet colours for the triangle strips ------------------
      do I=0, 17
	  if (mod(I,4) .le. 1) then
	      do J=1,3
		  FacetColrs(I*3+J)=Red(J)
	      end do
	  else
	      do J=1,3
		  FacetColrs(I*3+J)=Yellow(J)
	      end do
	  end if
      end do
      !--- define the vertex colours for the triangle strips -----------------
      do I=0, 19
	  if (mod(I,2) .eq. 1) then
	      do J=1,3
		  VertexColrs1(I*3+J)=Red(J)
		  VertexColrs2(I*3+J)=Yellow(J)
	      end do
	  else
	      do J=1,3
		  VertexColrs1(I*3+J)=Yellow(J)
		  VertexColrs2(I*3+J)=Red(J)
	      end do
	  end if
      end do
      !=== define the structure that does the triangle strips ================
      call popst(Strip)				! open structure
      !--- first: use interior colour ----------------------------------------
      call psism(PNOIS)				! set interior shading method
      call ptr3(.08, .28, 0., Error, Xform)	! translate 3
      call pslmt3(Xform, PCREPL)		! set local matrix 3
      call ptst3d(				! triangle strip 3D
     +	PFNO,					!   facet flag: none
     +	PENO,					!   edge flag: none
     +  PCD,					!   vertex flag: coords only
     +	PRGB, 3,				!   colour type RGB (3 coords)
     +	20,					!   number of vertices
     +  Dummy, Dummy,				!   facet colours
     +	Dummy, Dummy, Dummy,			!   facet normals
     +	Dummy, Dummy,				!   application data (facet)
     +  Dummy,					!   edge visibility flags
     +	TriStrip1X, TriStrip1Y, TriStrip1Z,	!   triangles' XYZ data
     +  Dummy, Dummy,				!   vertex colours
     +	Dummy, Dummy, Dummy,			!   vertex normals
     +	Dummy, Dummy)				!   application data (vertex)
      call ptst3d(				! triangle strip 3D
     +	PFNO,					!   facet flag: none
     +	PENO,					!   edge flag: none
     +  PCD,					!   vertex flag: coords only
     +	PRGB, 3,				!   colour type RGB (3 coords)
     +	20,					!   number of vertices
     +  Dummy, Dummy,				!   facet colours
     +	Dummy, Dummy, Dummy,			!   facet normals
     +	Dummy, Dummy,				!   application data (facet)
     +  Dummy,					!   edge visibility flags
     +	TriStrip2X, TriStrip2Y, TriStrip2Z,	!   triangles' XYZ data
     +  Dummy, Dummy,				!   vertex colours
     +	Dummy, Dummy, Dummy,			!   vertex normals
     +	Dummy, Dummy)				!   application data (vertex)
      !--- second: use facet colour ------------------------------------------
      call ptr3(.52, .28, 0., Error, Xform)	! translate 3
      call pslmt3(Xform, PCREPL)		! set local matrix 3
      call ptst3d(				! triangle strip 3D
     +	PFC,					!   facet flag: colour
     +	PENO,					!   edge flag: none
     +  PCD,					!   vertex flag: coords only
     +	PRGB, 3,				!   colour type RGB (3 coords)
     +	20,					!   number of vertices
     +  Dummy, FacetColrs,			!   facet colours
     +	Dummy, Dummy, Dummy,			!   facet normals
     +	Dummy, Dummy,				!   application data (facet)
     +  Dummy,					!   edge visibility flags
     +	TriStrip1X, TriStrip1Y, TriStrip1Z,	!   triangles' XYZ data
     +  Dummy, Dummy,				!   vertex colours
     +	Dummy, Dummy, Dummy,			!   vertex normals
     +	Dummy, Dummy)				!   application data (vertex)
      call ptst3d(				! triangle strip 3D
     +	PFC,					!   facet flag: none
     +	PENO,					!   edge flag: none
     +  PCD,					!   vertex flag: coords only
     +	PRGB, 3,				!   colour type RGB (3 coords)
     +	20,					!   number of vertices
     +  Dummy, FacetColrs,			!   facet colours
     +	Dummy, Dummy, Dummy,			!   facet normals
     +	Dummy, Dummy,				!   application data (facet)
     +  Dummy,					!   edge visibility flags
     +	TriStrip2X, TriStrip2Y, TriStrip2Z,	!   triangles' XYZ data
     +  Dummy, Dummy,				!   vertex colours
     +	Dummy, Dummy, Dummy,			!   vertex normals
     +	Dummy, Dummy)				!   application data (vertex)
      !--- third: use vertex colour ------------------------------------------
      call psism(PCIS)				! set interior shading method
      call ptr3(.52, .05, 0., Error, Xform)	! translate 3
      call pslmt3(Xform, PCREPL)		! set local matrix 3
      call ptst3d(				! triangle strip 3D
     +	PFNO,					!   facet flag: none
     +	PENO,					!   edge flag: none
     +  PCDC,					!   vertex flag: coords/colour
     +	PRGB, 3,				!   colour type RGB (3 coords)
     +	20,					!   number of vertices
     +  Dummy, Dummy,				!   facet colours
     +	Dummy, Dummy, Dummy,			!   facet normals
     +	Dummy, Dummy,				!   application data (facet)
     +  Dummy,					!   edge visibility flags
     +	TriStrip1X, TriStrip1Y, TriStrip1Z,	!   triangles' XYZ data
     +  Dummy, VertexColrs1,			!   vertex colours
     +	Dummy, Dummy, Dummy,			!   vertex normals
     +	Dummy, Dummy)				!   application data (vertex)
      call ptst3d(				! triangle strip 3D
     +	PFNO,					!   facet flag: none
     +	PENO,					!   edge flag: none
     +  PCDC,					!   vertex flag: coords only
     +	PRGB, 3,				!   colour type RGB (3 coords)
     +	20,					!   number of vertices
     +  Dummy, Dummy,				!   facet colours
     +	Dummy, Dummy, Dummy,			!   facet normals
     +	Dummy, Dummy,				!   application data (facet)
     +  Dummy,					!   edge visibility flags
     +	TriStrip2X, TriStrip2Y, TriStrip2Z,	!   triangles' XYZ data
     +  Dummy, VertexColrs2,			!   vertex colours
     +	Dummy, Dummy, Dummy,			!   vertex normals
     +	Dummy, Dummy)				!   application data (vertex)
      call pclst				! close structure
      return
      end