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

      integer	WorkstnID		! workstation ID
      parameter	(WorkstnID=1)		! user-selectable value
      integer	ConnID			! communication channel ID
      integer	Error			! error indicator
      !--- define structure IDs ----------------------------------------------
      integer	SceneID, PlaneID, CircleID, CylinderID, ConeID
      integer	SphereID, SquareID, CubeID
      common	/StructureIDs/ SceneID, PlaneID, CircleID, CylinderID
      common	/StructureIDs/ ConeID, SphereID, SquareID, CubeID
      data	SceneID, PlaneID, CircleID, CylinderID /1, 2, 3, 4/
      data	ConeID, SphereID, SquareID, CubeID /5, 6, 7, 8/

      real	CenterX, CenterY	! center of image rotation
      data	CenterX /5./, CenterY /5./
      real	M1(4,4), M2(4,4), M3(4,4), M4(4,4), M(4,4)	! matrices
      real	X, Y, Z				! temporary position variables
      real	X1, Y1, Z1, X2, Y2, Z2		! position last time/this time
      real	VelX1, VelY1, VelZ1		! velocity last time
      real	VelX2, VelY2, VelZ2		! velocity this time
      real	AccelX1, AccelY1, AccelZ1	! acceleration last time
      real	AccelX2, AccelY2, AccelZ2	! acceleration this time
      integer	I			! loop control variable
      integer	fdopen			! to get file descriptor

      real	rad, deg			! type the statement function
      rad(deg)=	((deg)*3.14159265358979/180.)	! convert degrees to radians
      
      !=== open PHIGS and workstation ========================================
      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 all needed structures ======================================
      !--- define the "floor" plane ------------------------------------------
      call popst(PlaneID)			! open structure 
      call Plane(0., 10., 1., 0., 10., 2.)	! define plane
      call pclst				! close structure
      !--- define the 2D shapes with supporting roles ------------------------
      call popst(CircleID)		! open structure
      call SupinePolygon(24)		! define a "circle"
      call pclst			! close structure
      call popst(SquareID)		! open structure
      call SupinePolygon(4)		! define a square
      call pclst			! close structure
      !--- define the cylinder -----------------------------------------------
      call popst(CylinderID)		! open structure 
      call Cylinder(1., .2, 1., .1)	! define cylinder
      call pclst			! close structure
      !--- define the cone ---------------------------------------------------
      call popst(ConeID)		! open structure
      call Cone(1., 2., .05)		! define cone
      call pclst			! close structure
      !--- define the sphere -------------------------------------------------
      call popst(SphereID)		! open structure 
      call Sphere(1., 5.)		! define sphere
      call pclst			! close structure
      !--- define the cube ---------------------------------------------------
      call popst(CubeID)		! open structure
      call Cube(sqrt(2.)/2, .1, 1., .1)	! define cube
      call pclst			! close structure
      !=== define the scene ==================================================
      call popst(SceneID)
      call psvwi(1)
      call pexst(PlaneID)
      !--- cone --------------------------------------------------------------
      call ptr3(5., 1., 0., Error, M)
      call pslmt3(M, PCREPL)
      call pexst(ConeID)
      !--- cylinders ---------------------------------------------------------
      call ptr3(2., 8., 0., Error, M)
      call pslmt3(M, PCREPL)
      call pexst(CylinderID)		! short, fat cylinder
      call ptr3(0., 0., -.5, Error, M)
      call psc3(.4, .4, 2., Error, M1)
      call AppendTransformation(M, M1)
      call prox(rad(90), Error, M1)
      call AppendTransformation(M, M1)
      call proz(rad(30), Error, M1)
      call AppendTransformation(M, M1)
      call ptr3(2.3, 8.3, 1.4, Error, M1)
      call AppendTransformation(M, M1)
      call pslmt3(M, PCREPL)
      call pexst(CylinderID)		! tall, thin cylinder
      !--- spheroids ---------------------------------------------------------
      call pbltm3(0.,0.,.0, 1.,1.,1., rad(45),0.,0., 1.,1.,1., Error, M)
      call pslmt3(M, PCREPL)
      call pexst(SphereID)		! sphere
      call pbltm3(0.,0.,.0, 8.,6.,2., 0.,0.,0., .5,.5,2., Error, M)
      call pslmt3(M, PCREPL)
      call pexst(SphereID)		! prolate spheroid
      call pbltm3(0.,0.,.0, 5.,1.,2.5, 0.,0.,0., 1.,1.,.5,
     +  Error, M)
      call pslmt3(M, PCREPL)
      call pexst(SphereID)		! oblate spheroid
      !--- cubes -------------------------------------------------------------
      call proz(rad(45), Error, M)
      call psc3(2., 1., 1., Error, M1)
      call AppendTransformation(M, M1)
      call prox(rad(90), Error, M1)
      call AppendTransformation(M, M1)
      call proz(rad(30), Error, M1)
      call AppendTransformation(M, M1)
      call ptr3(8., 3., .5, Error, M1)
      call AppendTransformation(M, M1)
      call pslmt3(M, PCREPL)
      call pexst(CubeID)		! bottom block
      call proz(rad(45), Error, M1)
      call proy(rad(90), Error, M2)
      call pcom3(M2, M1, Error, M3)
      call proz(rad(50), Error, M4)
      call pcom3(M4, M3, Error, M1)
      call ptr3(7.8, 2.5, 1.5, Error, M2)
      call pcom3(M2, M1, Error, M)
      call pslmt3(M, PCREPL)
      call pexst(CubeID)		! top cube
      call pclst			! close structure
      !=== move around/in the scene ==========================================
      call ppost(WorkstnID, SceneID, 1.0)	! post structure
      !--- go around the scene once ------------------------------------------
      do I=0,360,2
	  call PolarToRectangular(25., rad(I-90), rad(80), X, Y, Z)
	  call DefineCameraView(WorkstnID, 1,	! workstation id, view number
     +	    X+CenterX, Y+CenterY, Z,		! PRP (point looked from)
     +	    5., 5., 0.,				! VRP (point looked at)
     +	    30., PPERS,				! field of view, proj. type
     +      0., 0., 1.)				! up vector
	  call puwk(1, PPERFO)			! update workstation
      end do
      !--- look down on the scene from above ---------------------------------
      call psdus(WorkstnID, PASAP, PNIVE)	! set display update state...
      do I=80,4,-2				!  ...so we can avoid PUWKing.
	  call PolarToRectangular(25., rad(-90), rad(I), X, Y, Z)
	  call DefineCameraView(WorkstnID, 1,	! workstation id, view number
     +	    X+CenterX, Y+CenterY, Z,		! PRP (point looked from)
     +	    5., 5., 0.,				! VRP (point looked at)
     +	    30., PPERS,				! field of view, proj. type
     +      0., 0., 1.)				! up vector
      end do
      do I=4,90,2
	  call PolarToRectangular(25., rad(-90), rad(I), X, Y, Z)
	  call DefineCameraView(WorkstnID, 1,	! workstation id, view number
     +	    X+CenterX, Y+CenterY, Z,		! PRP (point looked from)
     +	    5., 5., 0.,				! VRP (point looked at)
     +	    30., PPERS,				! field of view, proj. type
     +      0., 0., 1.)				! up vector
      end do
      !--- move into the scene -----------------------------------------------
      X1=X+CenterX				! \  The point looked from at
      Y1=Y+CenterY				!  > the beginning of the  
      Z1=Z					! /  camera movement.
      X2=7.					! \  The point looked from at
      Y2=10.					!  > the end of the camera 
      Z2=1.					! /  movement.             
      do I=0,100
	  X=(100-I)*X1*.01+I*X2*.01		! \  Move linearly from point
	  Y=(100-I)*Y1*.01+I*Y2*.01		!  > 1 to point 2, in 101
	  Z=(100-I)*Z1*.01+I*Z2*.01		! /  easy steps
	  call DefineCameraView(WorkstnID, 1,	! workstation id, view number
     +	    X, Y, Z,				! PRP (point looked from)
     +	    5., 5., 0.,				! VRP (point looked at)
     +	    30., PPERS,				! field of view, proj. type
     +      0., 0., 1.)				! up vector
      end do
      !--- look up at the the cone/spheroid juncture -------------------------
      X1=5.					! \  The point looked at at
      Y1=5.					!  > the beginning of the  
      Z1=0.					! /  camera pan/tilt.      
      X2=5.					! \  The point looked at at
      Y2=1.					!  > the end of the camera 
      Z2=2.					! /  pan/tilt.             
      do I=0,50
	  X=(50-I)*X1*.02+I*X2*.02		! \  Move linearly from point
	  Y=(50-I)*Y1*.02+I*Y2*.02		!  > 1 to point 2, in 51
	  Z=(50-I)*Z1*.02+I*Z2*.02		! /  easy steps
	  call DefineCameraView(WorkstnID, 1,	! workstation id, view number
     +	    7., 10., 1.,			! PRP (point looked from)
     +	    X, Y, Z,				! VRP (point looked at)
     +	    30., PPERS,				! field of view, proj. type
     +      0., 0., 1.)				! up vector
      end do
      !--- zoom in on the cone/spheroid juncture -----------------------------
      do I=60,4,-1
	  call DefineCameraView(WorkstnID, 1,	! workstation id, view number
     +	    7., 10., 1.,			! PRP (point looked from)
     +	    X2, Y2, Z2,				! VRP (point looked at)
     +	    I*.5, PPERS,			! field of view, proj. type
     +      0., 0., 1.)				! up vector
      end do
      do I=4,270,2
	  call DefineCameraView(WorkstnID, 1,	! workstation id, view number
     +	    7., 10., 1.,			! PRP (point looked from)
     +	    X2, Y2, Z2,				! VRP (point looked at)
     +	    I*.5, PPERS,			! field of view, proj. type
     +      0., 0., 1.)				! up vector
      end do
      do I=270,120,-1
	  call DefineCameraView(WorkstnID, 1,	! workstation id, view number
     +	    7., 10., 1.,			! PRP (point looked from)
     +	    X2, Y2, Z2,				! VRP (point looked at)
     +	    I*.5, PPERS,			! field of view, proj. type
     +      0., 0., 1.)				! up vector
      end do
      !--- fly away as in an airplane ----------------------------------------
      AccelX1=0.
      AccelY1=0.
      AccelZ1=1.
      do I=0,1082
	  !--- devise a complex, but smooth, steadily rising flight path ---
	  X2=5-1.5*sin(rad(I*1.7))-.9*cos(rad(I*.34))
	  Y2=4+(I*.004+1)*cos(rad(I*1.3+15))+.5*sin(rad(I*1.6))
	  Z2=I*.003					
	  VelX2=X2-X1
	  VelY2=Y2-Y1
	  VelZ2=Z2-Z1
	  AccelX2=VelX2-VelX1
	  AccelY2=VelY2-VelY1
	  AccelZ2=VelZ2-VelZ1
	  if (I .gt. 3) then			! ignore anomalous values
	      call DefineCameraView(WorkstnID,1,! workstation id, view number
     +		X1, Y1, Z1,			! PRP (point looked from)
     +		X2, Y2, Z2,			! VRP (point looked at)
     +		90., PPERS,			! field of view, proj. type
     +		AccelX1, AccelY1, .003)		! up vector
	  end if
	  X1=X2
	  Y1=Y2
	  Z1=Z2
	  VelX1=VelX2
	  VelY1=VelY2
	  VelZ1=VelZ2
	  AccelX1=AccelX2
	  AccelY1=AccelY2
	  AccelZ1=AccelZ2
      end do
      call pclwk(WorkstnID)		! close workstation
      call pclph			! close PHIGS
      stop
      end
!*****************************************************************************
      subroutine Plane(Xmin, Xmax, dX, Ymin, Ymax, dY)
      real	Xmin, Xmax, Ymin, Ymax	! defines size of floor
      real	dX, dY			! size of tiles in floor
      include 'phigs.f2.h'		! get the HP-PHIGS constants

      real	X, Y			! loop control variables

      X=Xmin
      do while (X .le. Xmax+.00001)
	  call OneLine(X, Ymin, 0., X, Ymax, 0.)
	  X=X+dX
      end do
      Y=Ymin
      do while (Y .le. Ymax+.00001)
	  call OneLine(Xmin, Y, 0., Xmax, Y, 0.)
	  Y=Y+dY
      end do
      return