vertexcolour.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 VertexColour			! program "VertexColour.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	Cube, Scene			! structure IDs
      parameter	(Cube=1, Scene=2)		!   (values chosen by user)
      real	Gray(3), Black(3)		! for setting colours
      data	Gray /0.5, 0.5, 0.5/, Black /0.0, 0.0, 0.0/
      real	Matrix(4, 4)			! transformation matrix
      integer*4	Error				! error-return variable
      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 pscr(WorkstnID, 0, 3, Gray)		! set colour representation
      call BuildCube(Cube)			! define cube's geometry/colour
      call popst(Scene)				! open structure
      call psism(PCIS)				! set interior shading method
      call psedfg(PON)				! set edge flag on
      call psedc(PRGB, 0, 3, Black)		! set edge colour
      call psis(PSOLID)				! set interior style to solid
      call pbltm3(0.0, 0.0, 0.0,		! build local xform. matrix
     +  0.5, 0.5, 0.5,				!   translate
     +  rad(20.0), rad(20.0), rad(7.1),		!   rotate
     +  0.3, 0.3, 0.3,				!   scale
     +  Error, Matrix)				!   returned: error, matrix
      call pslmt3(Matrix, PCREPL)		! set local transformation 3
      call pexst(Cube)				! execute structure
      call pclst				! close structure
      call ppost(WorkstnID, Scene, 1.0)		! post structure
      call puwk(WorkstnID, PPERFO)		! update workstation
      call pclwk(WorkstnID)			! close workstation
      call pclph				! close phigs
      stop					! stop processing
      end					! end of program
!*****************************************************************************
      subroutine BuildCube(Cube)
      integer*4	Cube

      real*4	TopX(5), TopY(5), TopZ(5), TopColours(15)
      data	TopX	/-1.0, -1.0,  0.0,  1.0,  1.0/
      data	TopY	/ 1.0,  1.0,  1.0,  1.0,  1.0/
      data	TopZ	/-1.0,  1.0,  1.0,  0.0, -1.0/
      data	TopColours     /0.0, 1.0, 0.0,	! green
     +				1.0, 1.0, 0.0,	! yellow
     +				1.0, 1.0, 0.5,	! light yellow
     +				0.5, 1.0, 1.0,	! light cyan
     +				0.0, 1.0, 1.0/	! cyan
      real*4	BottomX(4), BottomY(4), BottomZ(4), BottomColours(12)
      data	BottomX	/-1.0, -1.0,  1.0,  1.0/
      data	BottomY	/-1.0, -1.0, -1.0, -1.0/
      data	BottomZ	/ 1.0, -1.0, -1.0,  1.0/
      data	BottomColours  /1.0, 0.0, 0.0,	! red
     +				0.0, 0.0, 0.0,	! black
     +				0.0, 0.0, 1.0,	! blue
     +				1.0, 0.0, 1.0/	! magenta
      real*4	RightX(5), RightY(5), RightZ(5), RightColours(15)
      data	RightX	/ 1.0,  1.0, 1.0, 1.0,  1.0/
      data	RightY	/-1.0,  1.0, 1.0, 0.0, -1.0/
      data	RightZ	/-1.0, -1.0, 0.0, 1.0,  1.0/
      data	RightColours   /0.0, 0.0, 1.0,	! blue
     +				0.0, 1.0, 1.0,	! cyan
     +				0.5, 1.0, 1.0,	! light cyan
     +				1.0, 0.5, 1.0,	! light magenta
     +				1.0, 0.0, 1.0/	! magenta
      real*4	LeftX(4), LeftY(4), LeftZ(4), LeftColours(12)
      data	LeftX	/-1.0, -1.0, -1.0, -1.0/
      data	LeftY	/-1.0,  1.0,  1.0, -1.0/
      data	LeftZ	/ 1.0,  1.0, -1.0, -1.0/
      data	LeftColours    /1.0, 0.0, 0.0,	! red
     +				1.0, 1.0, 0.0,	! yellow
     +				0.0, 1.0, 0.0,	! green
     +				0.0, 0.0, 0.0/	! black
      real*4	FrontX(5), FrontY(5), FrontZ(5), FrontColours(15)
      data	FrontX	/ 1.0, 1.0, 0.0, -1.0, -1.0/
      data	FrontY	/-1.0, 0.0, 1.0,  1.0, -1.0/
      data	FrontZ	/ 1.0, 1.0, 1.0,  1.0,  1.0/
      data	FrontColours   /1.0, 0.0, 1.0,	! magenta
     +				1.0, 0.5, 1.0,	! light magenta
     +				1.0, 1.0, 0.5,	! light yellow
     +				1.0, 1.0, 0.0,	! yellow
     +				1.0, 0.0, 0.0/	! red
      real*4	BackX(4), BackY(4), BackZ(4), BackColours(12)
      data	BackX	/-1.0, -1.0,  1.0,  1.0/
      data	BackY	/-1.0,  1.0,  1.0, -1.0/
      data	BackZ	/-1.0, -1.0, -1.0, -1.0/
      data	BackColours    /0.0, 0.0, 0.0,	! black
     +				0.0, 1.0, 0.0,	! green
     +				0.0, 1.0, 1.0,	! cyan
     +				0.0, 0.0, 1.0/	! blue
      real*4	CornerX(3), CornerY(3), CornerZ(3), CornerColours(9)
      data	CornerX	/1.0, 1.0, 0.0/
      data	CornerY	/0.0, 1.0, 1.0/
      data	CornerZ	/1.0, 0.0, 1.0/
      data	CornerColours  /1.0, 0.5, 1.0,	! light magenta
     +				0.5, 1.0, 1.0,	! light cyan
     +				1.0, 1.0, 0.5/	! light yellow

      call popst(Cube)				! open structure
      call FillAreaSet(4, BackX, BackY, BackZ, BackColours)
      call FillAreaSet(4, BottomX, BottomY, BottomZ, BottomColours)
      call FillAreaSet(4, LeftX, LeftY, LeftZ, LeftColours)
      call FillAreaSet(5, RightX, RightY, RightZ, RightColours)
      call FillAreaSet(5, TopX, TopY, TopZ, TopColours)
      call FillAreaSet(5, FrontX, FrontY, FrontZ, FrontColours)
      call FillAreaSet(3, CornerX, CornerY, CornerZ, CornerColours)
      call pclst				! close structure
      return
      end
!*****************************************************************************
      subroutine FillAreaSet(Vertices, VertX, VertY, VertZ, VertRGB)
      integer*4	Vertices		! number of vertices in this polygon
      real	VertX, VertY, VertZ	! vertex geometry
      real	VertRGB			! vertex colours
      include 'phigs.f2.h'
      
      integer*4	Dummy			! place-holder for unused parameters
      
      call pfas3d(			! fill area set 3 with data
     +  PFNO,				!   facet flag: none
     +  PENO,				!   edge flag: none
     +  PCDC,				!   vertex flag: coords/colours
     +  PRGB, 3,			!   colour type: RGB
     +  Dummy,				!   indexed colour
     +  Dummy,				!   facet colours
     +  Dummy, Dummy, Dummy,		!   facet normals
     +  Dummy, Dummy,			!   facet application data
     +  1,				!   number of fill areas/set
     +  Vertices,			!   how many vertices/polygon?
     +  Dummy,				!   edge flags
     +  VertX, VertY, VertZ,		!   polygon's geometry
     +  Dummy,				!   vertex indirect colours
     +  VertRGB,			!   vertex direct colours
     +  Dummy, Dummy, Dummy,		!   vertex normals
     +	Dummy, Dummy)			!   vertex application data
      return
      end