depthcue.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 DepthCue				! program "DepthCue.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)		!   (chosen by user)
      integer*4	Error				! error-return variable
      integer*4 fdopen				! to get file descriptor

      real*4 TopX(5), TopY(5), TopZ(5)
      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/
      real*4 BottomX(4), BottomY(4), BottomZ(4)
      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/
      real*4 RightX(5), RightY(5), RightZ(5)
      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/
      real*4 LeftX(4), LeftY(4), LeftZ(4)
      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/
      real*4 FrontX(5), FrontY(5), FrontZ(5)
      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/
      real*4 BackX(4), BackY(4), BackZ(4)
      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/
      real*4 CornerX(3), CornerY(3), CornerZ(3)
      data CornerX /1.0, 1.0, 0.0/
      data CornerY /0.0, 1.0, 1.0/
      data CornerZ /1.0, 0.0, 1.0/
      real*4	White(3)			! for line colour
      data	White /1.0, 1.0, 1.0/		! RGB for white
      real*4	DepthCueColour(3)		! for depth-cue colour
      data	DepthCueColour /0.3, 0.3, 0.3/	! RGB for a shade of gray
      real*4	xform(3, 3)			! transformation matrix
      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 psdus(WorkstnID, PASAP,PNIVE)	! set display update state
      call pscr(WorkstnID, 1, 3, White)		! set colour representation
      !--- set depth cue representation for entry 1 --------------------------
      call psdcr(WorkstnID, 			! set depth cue representation
     +  1, 					!   depth cue index
     +  PALLOW,					!   turn on depth cueing
     +  0.25, 0.75, 				!   back/front plane distances
     +  0.0, 1.0, 				!   back/front intensities
     +  PRGB, 0, 3, DepthCueColour)		!   depth-cue colour
      !--- define the Cube structure -----------------------------------------
      call popst(Cube)				! open structure
      call psc3(0.25, 0.5, 0.5, Error, xform)	! scale anisotropically
      if (Error .ne. 0) then
	  print *,"Error", Error, " in first psc3."
	  stop
      end if
      call pslmt3(xform, PCREPL)		! set local transformation 3
      call psc3(.7, .7, .7, Error, xform)	! scale to 70% size
      if (Error .ne. 0) then
	  print *,"Error", Error, " in second psc3."
	  stop
      end if
      call pslmt3(xform, PCPOST)		! set local transformation
      call proy(rad(10.), Error, xform)		! rotate about Y axis
      if (Error .ne. 0) then
	  print *,"Error", Error, " in proy."
	  stop
      end if
      call pslmt3(xform, PCPOST)		! set local transformation
      call prox(rad(10.), Error, xform)		! rotate about X axis
      if (Error .ne. 0) then
	  print *,"Error", Error, " in prox."
	  stop
      end if
      call pslmt3(xform, PCPOST)		! set local transformation
      call ptr3(.5, .5, .5, Error, xform)	! translate back into position
      if (Error .ne. 0) then
	  print *,"Error", Error, " in ptr3."
	  stop
      end if
      call pslmt3(xform, PCPOST)		! set local transformation
      call pfa3(4, BackX, BackY, BackZ)		! \
      call pfa3(4, BottomX, BottomY, BottomZ)	!  \
      call pfa3(5, RightX, RightY, RightZ)	!   \  define the mutated,
      call pfa3(4, LeftX, LeftY, LeftZ)		!    > truncated cube with
      call pfa3(5, TopX, TopY, TopZ)		!   /  seven fill areas
      call pfa3(5, FrontX, FrontY, FrontZ)	!  /
      call pfa3(3, CornerX, CornerY, CornerZ)	! /
      call pclst				! close structure
      !--- open the Scene structure ------------------------------------------
      call popst(Scene)				! open structure
      call psdci(1)				! set depth cue index
      call psedfg(PON)				! set edge flag
      call psis(PHOLLO)				! set interior style
      call pexst(Cube)				! execute structure
      call pclst				! close structure
      call ppost(WorkstnID, Scene, 1.0)		! post structure
      call pclwk(WorkstnID)			! close workstation
      call pclph				! close phigs
      stop					! stop processing
      end					! end of program