fourviews.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 FourViews			! file "FourViews.f"
      include 'phigs.f2.h'		! get the HP-PHIGS constants

      integer*4	WorkstnID		! workstation ID
      parameter	(WorkstnID=1)		! value chosen by user
      integer*4	ConnID			! communication channel ID
      integer*4	Error			! error indicator
      integer*4	Scene, Cube		! structure IDs
      parameter	(Scene=1, Cube=2)	! values chosen by user
      !--- viewing variables -------------------------------------------------
      real	Orientation(4,4), Mapping(4,4)

      real	WindowLimits1(4)				! +---+---+
      data	WindowLimits1 /-1.75, 1.75, -1.75, 1.75/	! |   | X |
      real	ViewportLimits1(6), ClipLimits1(6)		! +---+---+
      data	ViewportLimits1 /.5, 1., .5, 1., 0., 1./	! |   |   |
      data	ClipLimits1 /.5, 1., .5, 1., 0., 1./		! +---+---+

      real	WindowLimits2(4)				! +---+---+
      data	WindowLimits2 /-1.25, 1.25, -1.25, 1.25/	! | X |   |
      real	ViewportLimits2(6), ClipLimits2(6)		! +---+---+
      data	ViewportLimits2 /0., .5, .5, 1., 0., 1./	! |   |   |
      data	ClipLimits2 /0., .5, .5, 1., 0., 1./		! +---+---+

      real	WindowLimits3(4)				! +---+---+
      data	WindowLimits3 /-1.25, 1.25, -1.25, 1.25/	! |   |   |
      real	ViewportLimits3(6), ClipLimits3(6)		! +---+---+
      data	ViewportLimits3 /0., .5, 0., .5, 0., 1./	! | X |   |
      data	ClipLimits3 /0., .5, 0., .5, 0., 1./		! +---+---+

      real	WindowLimits4(4)				! +---+---+
      data	WindowLimits4 /-1.25, 1.25, -1.25, 1.25/	! |   |   |
      real	ViewportLimits4(6), ClipLimits4(6)		! +---+---+
      data	ViewportLimits4 /.5, 1., 0., .5, 0., 1./	! |   | X |
      data	ClipLimits4 /.5, 1., 0., .5, 0., 1./		! +---+---+
      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, POIDDX)		! open workstation
      !--- define view 1 -----------------------------------------------------
      call pevom3(			! evaluate view orientation matrix
     +	0., 0., 0.,			!   view reference point
     +	.4, .3, 1.,			!   view plane normal
     +	0., 1., 0.,			!   view up vector
     +	Error, Orientation)		!   returned variables
      if (Error .ne. 0) call PrintError(Error, "pevom3")
      call pevmm3(			! evaluate view mapping matrix
     +	WindowLimits1, ViewportLimits1,	!   window, viewport
     +	PPERS,				!   perspective projection
     +	0., 0., 10.,			!   projection reference point
     +	0., -2.5, 2.5,			!   view/back/front plane distance
     +	Error, Mapping)			!   returned variables
      if (Error .ne. 0) call PrintError(Error, "pevmm3")
      call psvwr3(WorkstnID, 1,		! set view representation: view 1
     +	Orientation, Mapping,		!   returned from pevom3, pevmm3
     +	ClipLimits1,			!   same as viewport
     +	PCLIP, PCLIP, PCLIP)		!   xy/back/front clip indicators
      !--- define view 2 -----------------------------------------------------
      call pevom3(			! evaluate view orientation matrix
     +	0., 0., 0.,			!   view reference point
     +	0., 1., 0.,			!   view plane normal
     +	0., 0.,-1.,			!   view up vector
     +	Error, Orientation)		!   returned variables
      if (Error .ne. 0) call PrintError(Error, "pevom3")
      call pevmm3(			! evaluate view mapping matrix
     +	WindowLimits2, ViewportLimits2,	!   window, viewport
     +	PPARL,				!   parallel projection
     +	0., 0., 10.,			!   projection reference point
     +	0., -2.5, 2.5,			!   view/back/front plane distance
     +	Error, Mapping)			!   returned variables
      if (Error .ne. 0) call PrintError(Error, "pevmm3")
      call psvwr3(WorkstnID, 2,		! set view representation: view 2
     +	Orientation, Mapping,		!   returned from pevom3, pevmm3
     +	ClipLimits2,			!   same as viewport
     +	PCLIP, PCLIP, PCLIP)		!   xy/back/front clip indicators
      !--- define view 3 -----------------------------------------------------
      call pevom3(			! evaluate view orientation matrix
     +	0., 0., 0.,			!   view reference point
     +	0., 0., 1.,			!   view plane normal
     +	0., 1., 0.,			!   view up vector
     +	Error, Orientation)		!   returned variables
      if (Error .ne. 0) call PrintError(Error, "pevom3")
      call pevmm3(			! evaluate view mapping matrix
     +	WindowLimits3, ViewportLimits3,	!   window, viewport
     +	PPARL,				!   parallel projection
     +	0., 0., 10.,			!   projection reference point
     +	0., -2.5, 2.5,			!   view/back/front plane distance
     +	Error, Mapping)			!   returned variables
      if (Error .ne. 0) call PrintError(Error, "pevmm3")
      call psvwr3(WorkstnID, 3,		! set view representation: view 3
     +	Orientation, Mapping,		!   returned from pevom3, pevmm3
     +	ClipLimits3,			!   same as viewport
     +	PCLIP, PCLIP, PCLIP)		!   xy/back/front clip indicators
      !--- define view 4 -----------------------------------------------------
      call pevom3(			! evaluate view orientation matrix
     +	0., 0., 0.,			!   view reference point
     +	1., 0., 0.,			!   view plane normal
     +	0., 1., 0.,			!   view up vector
     +	Error, Orientation)		!   returned variables
      if (Error .ne. 0) call PrintError(Error, "pevom3")
      call pevmm3(			! evaluate view mapping matrix
     +	WindowLimits4, ViewportLimits4,	!   window, viewport
     +	PPARL,				!   parallel projection
     +	0., 0., 10.,			!   projection reference point
     +	0., -2.5, 2.5,			!   view/back/front plane distance
     +	Error, Mapping)			!   returned variables
      if (Error .ne. 0) call PrintError(Error, "pevmm3")
      call psvwr3(WorkstnID, 4,		! set view representation: view 4
     +	Orientation, Mapping,		!   returned from pevom3, pevmm3
     +	ClipLimits4,			!   same as viewport
     +	PCLIP, PCLIP, PCLIP)		!   xy/back/front clip indicators
      !--- define the structure ----------------------------------------------
      call BuildCube(Cube)
      call popst(Scene)			! open structure
      call psvwi(1)			! set view index: 1
      call pexst(Cube)			! execute structure
      call psvwi(2)			! set view index: 2
      call pexst(Cube)			! execute structure
      call psvwi(3)			! set view index: 3
      call pexst(Cube)			! execute structure
      call psvwi(4)			! set view index: 4
      call pexst(Cube)			! execute structure
      call pclst			! close structure
      !--- close up shop -----------------------------------------------------
      call ppost(WorkstnID, Scene, 1.0)	! post structure Scene
      call puwk(WorkstnID, PPERFO)	! update workstation
      call pclwk(WorkstnID)		! close workstation
      call pclph			! close PHIGS
      end
!*****************************************************************************
      subroutine BuildCube(Cube)
      include 'phigs.f2.h'		! get the HP-PHIGS constants
      integer*4	Cube

      integer*4	NumPoints(1)		! index array
      !--- Truncated cube data.  Points are defined in anti-clockwise order --
      !--- so that front faces point out from origin.  -----------------------
      real	TopX(5), TopY(5), TopZ(5)
      data	TopX /-1., -1.,  0.,  1.,  1./
      data	TopY / 1.,  1.,  1.,  1.,  1./
      data	TopZ /-1.,  1.,  1.,  0., -1./
      real	TopDirX(2), TopDirY(2), TopDirZ(2)
      data	TopDirX /1.,0./, TopDirY /0.,0./, TopDirZ /0.,-1./
      real	BottomX(4), BottomY(4), BottomZ(4)
      data	BottomX /-1., -1.,  1.,  1./
      data	BottomY /-1., -1., -1., -1./
      data	BottomZ / 1., -1., -1.,  1./
      real	RightX(5), RightY(5), RightZ(5)
      data	RightX / 1.,  1.,  1.,  1.,  1./
      data	RightY /-1.,  1.,  1.,  0., -1./
      data	RightZ /-1., -1.,  0.,  1.,  1./
      real	RightDirX(2), RightDirY(2), RightDirZ(2)
      data	RightDirX /0.,0./, RightDirY /0.,1./, RightDirZ /-1.,0./
      real	LeftX(4), LeftY(4), LeftZ(4)
      data	LeftX /-1., -1., -1., -1./
      data	LeftY /-1.,  1.,  1., -1./
      data	LeftZ / 1.,  1., -1., -1./
      real	FrontX(5), FrontY(5), FrontZ(5)
      data	FrontX / 1.,  1.,  0., -1., -1./
      data	FrontY /-1.,  0.,  1.,  1., -1./
      data	FrontZ / 1.,  1.,  1.,  1.,  1./
      real	FrontDirX(2), FrontDirY(2), FrontDirZ(2)
      data	FrontDirX /1.,0./, FrontDirY /0.,1./, FrontDirZ /0.,0./
      real	BackX(4), BackY(4), BackZ(4)
      data	BackX /-1., -1.,  1.,  1./
      data	BackY /-1.,  1.,  1., -1./
      data	BackZ /-1., -1., -1., -1./
      real	CornerX(3), CornerY(3), CornerZ(3)
      data	CornerX /1.,  1.,  0./
      data	CornerY /0.,  1.,  1./
      data	CornerZ /1.,  0.,  1./

      call popst(Cube)			! open structure
      call psfcm(PBKFC)			! set face-cull mode: back-facing
      call pschh(.4)			! set character height
      call pschxp(.8)			! set character expansion factor
      !--- do top of cube ----------------------------------------------------
      NumPoints(1)=5
      call pfas3(1, NumPoints, TopX, TopY, TopZ)	   ! fill area set 3
      call ptx3(-.75, 1., 0., TopDirX, TopDirY, TopDirZ, 'Top')
      !--- do bottom of cube -------------------------------------------------
      NumPoints(1)=4
      call pfas3(1, NumPoints, BottomX, BottomY, BottomZ)  ! fill area set 3
      !--- do right side of cube ---------------------------------------------
      NumPoints(1)=5
      call pfas3(1, NumPoints, RightX, RightY, RightZ)	   ! fill area set 3
      call ptx3(1., -.75, .75, RightDirX, RightDirY, RightDirZ, 'Right')
      !--- do left side of cube ----------------------------------------------
      NumPoints(1)=4
      call pfas3(1, NumPoints, LeftX, LeftY, LeftZ)	   ! fill area set 3
      !--- do front of cube --------------------------------------------------
      NumPoints(1)=5
      call pfas3(1, NumPoints, FrontX, FrontY, FrontZ)	   ! fill area set 3
      call ptx3(-.75, -.75, 1., FrontDirX, FrontDirY, FrontDirZ,'Front')
      !--- do back of cube ---------------------------------------------------
      NumPoints(1)=4
      call pfas3(1, NumPoints, BackX, BackY, BackZ)	   ! fill area set 3
      !--- do truncated corner of cube ---------------------------------------
      NumPoints(1)=3
      call pfas3(1, NumPoints, CornerX, CornerY, CornerZ)  ! fill area set 3
      call pclst				! close structure
      return
      end
!*****************************************************************************
      subroutine PrintError(Error, Routine)
      integer*4		Error
      character*6	Routine
      
      print *, "Error", Error, " in ", Routine, "; terminating."
      stop
      end