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

      integer*4	WorkstnID		! workstation ID
      parameter	(WorkstnID=1)
      integer*4	ConnID			! communication channel ID
      integer*4	Error			! error indicator
      integer*4	Scene, Cube		! structure IDs
      parameter	(Scene=1, Cube=2)
      !--- viewing variables -------------------------------------------------
      real	WindowLimits(4)		!  window limits
      real	ViewportLimits(6)		!  viewport limits
      real	ClipLimits(6)		!  clipping limits
      data	WindowLimits	/-1.75, 1.75, -1.75, 1.75/
      data	ViewportLimits	/0., 1., 0., 1., 0., 1./
      data	ClipLimits	/0., 1., 0., 1., 0., 1./
      real	PRPx, PRPy, PRPz	!  projection reference point
      parameter	(PRPx=0., PRPy=0., PRPz=1.)
      real	ViewPlnDist		!  view plane distance
      real	BackPlnDist		!  back plane distance
      real	FrontPlnDist		!  front plane distance
      parameter	(ViewPlnDist=0., BackPlnDist=-5., FrontPlnDist=5.)
      real	Orientation(4,4), Mapping(4,4)
      !--- working variables -------------------------------------------------
      real	Angle			! rotation angle for editing structure
      real	Replacement(4,4), Ymat(4,4), Xmat(4,4)
      integer*4	I			! loop control 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, POIDDX)		! open workstation
      !--- define view 1 -----------------------------------------------------
      call pevom3(			! evaluate view orientation matrix
     +  0.0, 0.0, 0.0,			! view reference point
     +  0.4, 0.3, 1.0,			! view plane normal
     +  0.0, 1.0, 0.0,			! view up vector
     +  Error, Orientation)		! returned items
      if (Error .ne. 0) then
	  print *,"Error",Error,"in pevom3; terminating."
	  stop
      endif
      call pevmm3(			! evaluate view mapping matrix
     +  WindowLimits, ViewportLimits, PPARL, PRPx, PRPy, PRPz,
     +  ViewPlnDist, BackPlnDist, FrontPlnDist, Error, Mapping)
      if (Error .ne. 0) then
	  print *,"Error",Error,"in pevmm3; terminating."
	  stop
      endif
      call psvwr3(			! set view representation
     +  WorkstnID, 1, Orientation, Mapping, ClipLimits,
     +  PCLIP, PCLIP, PCLIP)
      !--- create the structure ----------------------------------------------
      call BuildCube(Cube)
      call prox(0.0, Error, Replacement)! rotate in x (make identity matrix)
      call popst(Scene)			! open structure
      call psvwi(1)			! set view index
      call pslmt3(Replacement, PCREPL)	! set local transformation matrix
      call pexst(Cube)			! execute structure
      call pclst			! close structure
      call ppost(WorkstnID, Scene, 1.0)	! post structure Scene
      call puwk(WorkstnID, PPERFO)	! update workstation
      call prox(0.0, Error, Xmat)	! rotate in x (make identity matrix)
      call prox(0.0, Error, Ymat)	! rotate in x (make identity matrix)
      call prox(0.0, Error, Replacement)! rotate in x (make identity matrix)
      call psedm(PREPLC)		! set edit mode (to "replace")
      call popst(Scene)			! open structure
      do 10 i=0,1440
	  Angle = (I*.25)*0.017453292	! convert degrees to radians
	  !--- create matrices for rotation in x and y -----------------------
          call proy(Angle, Error, Ymat)	! rotate in x
          call prox(Angle, Error, Xmat)	! rotate in y
          call pcom3(Xmat, Ymat, Error, Replacement)	! concatenate matrices
          call psep(2)			! set element pointer to 2
          call pslmt3(Replacement, PCREPL)! set local transformation matrix
          call prst(WorkstnID, PALWAY)	! redraw all structures
   10 continue				! end of "do" loop
      call pclst()			! close structure
      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