zoomview.f

Intro/: Directory containing introductory examples. HelloWorld.c A simple program that draws a bo

      end
!*****************************************************************************
      subroutine OneLine(X1, Y1, Z1, X2, Y2, Z2)
      real	X1, Y1, Z1, X2, Y2, Z2
      
      real	X(2), Y(2), Z(2)
      
      X(1)=X1
      Y(1)=Y1
      Z(1)=Z1
      X(2)=X2
      Y(2)=Y2
      Z(2)=Z2
      call ppl3(2, X, Y, Z)
      return
      end
!*****************************************************************************
      subroutine SupinePolygon(Sides)
      integer	Sides			! number of sides of polygon
      
      real	X(360), Y(360), Z(360)	! XYZ data for POLYLINE 3
      integer	dTheta, I, Index	! loop control variables
      real	Theta			! temporary variable

      real	rad, deg			! type the statement function
      rad(deg)=	((deg)*3.14159265358979/180.)	! convert degrees to radians

      dTheta=360/Sides			! degrees per side
      Index=1				! for array subscripts
      do I=0, 360, dTheta 		! for each side...
	  Theta=rad(I)			!   convert degrees to radians
	  X(Index)=cos(Theta)		!   \
	  Y(Index)=sin(Theta)		!    > calculate XYZ data
	  Z(Index)=0.			!   /
	  Index=Index+1			!   increment array subscript
      end do
      call ppl3(Sides+1, X, Y, Z)	! polyline 3
      return
      end
!*****************************************************************************
      subroutine Cylinder(Radius, dRadius, Height, dHeight)
      real	Radius			! radius of cylinder
      real	dRadius			! distance between circles in top/btm
      real	Height			! total height of cylinder
      real	dHeight			! distance between layers in cylinder
      include 'phigs.f2.h'		! get the HP-PHIGS constants

      integer	SceneID, PlaneID, CircleID, CylinderID, ConeID
      integer	SphereID, SquareID, CubeID
      common	/StructureIDs/ SceneID, PlaneID, CircleID, CylinderID
      common	/StructureIDs/ ConeID, SphereID, SquareID, CubeID

      real	M1(4,4), M2(4,4), M(4,4)! transformation matrices
      integer	Error			! error return variable
      real	R, Z			! loop control variables
      
      R=dRadius				! initial radius
      do while (R .le. Radius)
	  !--- do bottom first -----------------------------------------------
	  call psc3(R, R, 1., Error, M1)! scale 3
	  call pslmt3(M1, PCREPL)	! set local transformation 3
	  call pexst(CircleID)		! execute structure
	  !--- then do top ---------------------------------------------------
	  call ptr3(0., 0., Height, Error, M2)		! translate 3
	  call pcom3(M1, M2, Error, M)	! compose matrix 3
	  call pslmt3(M, PCREPL)	! set local transformation 3
	  call pexst(CircleID)		! execute structure
	  R=R+dRadius			! increment the radius
      end do
      Z=0.
      call psc3(Radius, Radius, 1., Error, M1)	! scale 3
      do while (Z .le. Height)
	  call ptr3(0., 0., Z, Error, M2)		! translate 3
	  call pcom3(M1, M2, Error, M)	! compose matrix 3
	  call pslmt3(M, PCREPL)	! set local transformation 3
	  call pexst(CircleID)		! execute structure
	  Z=Z+dHeight			! increment the height
      end do
      return
      end
!*****************************************************************************
      subroutine Cone(Radius, Height, dHeight)
      real	Radius			! radius of sphere
      real	Height			! height of whole cone
      real	dHeight			! distance between rings
      include 'phigs.f2.h'		! get the HP-PHIGS constants

      integer	SceneID, PlaneID, CircleID, CylinderID, ConeID
      integer	SphereID, SquareID, CubeID
      common	/StructureIDs/ SceneID, PlaneID, CircleID, CylinderID
      common	/StructureIDs/ ConeID, SphereID, SquareID, CubeID

      real	M1(4,4), M2(4,4), M(4,4)! transformation matrices
      integer	Error			! error return variable
      real	Z, R			! loop control variable

      Z=dHeight				! initial height
      do while (Z .le. Height)
	  R=Radius*((Height-Z)/Height)
	  call psc3(R, R, 1., Error, M1)! scale 3
	  call ptr3(0., 0., Z, Error, M2)	! translate 3
	  call pcom3(M1, M2, Error, M)	! compose matrix 3
	  call pslmt3(M, PCREPL)	! set local transformation 3
	  call pexst(CircleID)		! execute structure
	  Z=Z+dHeight			! increment the height
      end do
      return
      end
!*****************************************************************************
      subroutine Sphere(Radius, dPhi)
      real	Radius			! radius of sphere
      real	dPhi			! angular distance between latitudes
      include 'phigs.f2.h'		! get the HP-PHIGS constants

      integer	SceneID, PlaneID, CircleID, CylinderID, ConeID
      integer	SphereID, SquareID, CubeID
      common	/StructureIDs/ SceneID, PlaneID, CircleID, CylinderID
      common	/StructureIDs/ ConeID, SphereID, SquareID, CubeID

      real	M1(4,4), M2(4,4), M(4,4)! transformation matrices
      integer	Error			! error return variable
      real	Phi, R, Z		! loop control variables

      real	rad, deg			! type the statement function
      rad(deg)=	((deg)*3.14159265358979/180.)	! convert degrees to radians
      
      Phi=dPhi				! initial radius
      do while (Phi .lt. 180.)
	  R=Radius*sin(rad(Phi))
	  call psc3(R, R, 1., Error, M1)! scale 3
	  Z=Radius*cos(rad(Phi))
	  call ptr3(0., 0., Z, Error, M2)	! translate 3
	  call pcom3(M1, M2, Error, M)	! compose matrix 3
	  call pslmt3(M, PCREPL)	! set local transformation 3
	  call pexst(CircleID)		! execute structure
	  Phi=Phi+dPhi			! increment Phi
      end do
      return
      end
!*****************************************************************************
      subroutine Cube(Distance, dDistance, Height, dHeight)
      real	Distance		! center-to-corner distance
      real	dDistance		! distance between vertices in top/btm
      real	Height			! total height of cube
      real	dHeight			! distance between layers in cube
      include 'phigs.f2.h'		! get the HP-PHIGS constants

      integer	SceneID, PlaneID, CircleID, CylinderID, ConeID
      integer	SphereID, SquareID, CubeID
      common	/StructureIDs/ SceneID, PlaneID, CircleID, CylinderID
      common	/StructureIDs/ ConeID, SphereID, SquareID, CubeID

      real	M1(4,4), M2(4,4), M(4,4)! transformation matrices
      integer	Error			! error return variable
      real	Dist, Z			! loop control variables
      
      Dist=dDistance				! initial radius
      do while (Dist .le. Distance)
	  !--- do bottom first -----------------------------------------------
	  call psc3(Dist, Dist, 1., Error, M1)! scale 3
	  call pslmt3(M1, PCREPL)	! set local transformation 3
	  call pexst(SquareID)		! execute structure
	  !--- then do top ---------------------------------------------------
	  call ptr3(0., 0., Height, Error, M2)		! translate 3
	  call pcom3(M1, M2, Error, M)	! compose matrix 3
	  call pslmt3(M, PCREPL)	! set local transformation 3
	  call pexst(SquareID)		! execute structure
	  Dist=Dist+dDistance		! increment the "radius"
      end do
      Z=0.
      call psc3(Distance, Distance, 1., Error, M1)	! scale 3
      do while (Z .le. Height)
	  call ptr3(0., 0., Z, Error, M2)		! translate 3
	  call pcom3(M1, M2, Error, M)	! compose matrix 3
	  call pslmt3(M, PCREPL)	! set local transformation 3
	  call pexst(SquareID)		! execute structure
	  Z=Z+dHeight			! increment the height
      end do
      return
      end
!*****************************************************************************
      subroutine DefineCameraView(WorkstnID, ViewNo, PRPx, PRPy, PRPz,
     +  VRPx, VRPy, VRPz, FieldOfView, ProjType, VUPx, VUPy, VUPz)
      integer	WorkstnID, ViewNo	! workstation id, view to be defined
      real	PRPx, PRPy, PRPz	! Proj. Ref. Point (point looked from)
      real	VRPx, VRPy, VRPz	! View Ref. Point (point looked at)
      real	FieldOfView		! "zoomness" in degrees
      integer	ProjType		! parallel or perspective?
      real	VUPx, VUPy, VUPz	! view up vector
      include 'phigs.f2.h'		! get the HP-PHIGS constants

      real	VPNx, VPNy, VPNz	! view plane normal
      real	FPD, BPD		! front/back place distance
      real	Mapping(4,4)		! view mapping matrix
      real	Orientation(4,4)	! view orientation matrix
      real	Distance		! distance from PRP to VRP
      real	Wndw, Window(4)		! window limits
      real	Viewport(6)		! viewport limits
      real	ClipLimits(6)		! clip limits
      data	Viewport   /0.0, 1.0, 0.0, 1.0, 0.0, 1.0/
      data	ClipLimits /0.0, 1.0, 0.0, 1.0, 0.0, 1.0/
      integer	Error			! error return variable
      
      real	rad, deg			! type the statement function
      rad(deg)=	((deg)*3.14159265358979/180.)	! convert degrees to radians

      VPNx=PRPx-VRPx			! \  View Plane Normal determined by
      VPNy=PRPy-VRPy			!  > Projection Reference Point and
      VPNz=PRPz-VRPz			! /  View Reference Point.
      call pevom3(VRPx, VRPy, VRPz, VPNx, VPNy, VPNz, VUPx, VUPy, VUPz,
     +  Error, Orientation)
      if (Error .ne. 0) then
	  print *, "Error", Error, " in pevom3; terminating."
	  stop
      end if
      Distance=sqrt((PRPx-VRPx)**2+(PRPy-VRPy)**2+(PRPz-VRPz)**2)
      Wndw=Distance*tan(rad(FieldOfView)/2)	! FOV determines window size
      Window(1)=-Wndw			! \
      Window(2)=Wndw			!  \ This assumes a square window
      Window(3)=-Wndw			!  / (aspect ratio=1.00).
      Window(4)=Wndw			! /
      FPD=Distance-0.01			! right in front of eye point
      BPD=-450*Distance			! virtually infinite
      call pevmm3(Window, Viewport, ProjType, 0., 0., Distance,
     +  0., BPD, FPD, Error, Mapping)
      if (Error .ne. 0) then
	  print *, "Error", Error, " in pevmm3; terminating."
	  stop
      end if
      call psvwr3(WorkstnID, ViewNo, Orientation, Mapping, ClipLimits,
     +  PCLIP, PCLIP, PCLIP)
      return
      end
!*****************************************************************************
      subroutine PolarToRectangular(R, Theta, Phi, X, Y, Z)
      real	R, Theta, Phi		! input: 3D polar (spherical) coords
      real	X, Y, Z			! output: 3D rect. (Cartesian) coords
      
      X=R*sin(Phi)*cos(Theta)
      Y=R*sin(Phi)*sin(Theta)
      Z=R*cos(Phi)
      return
      end
!*****************************************************************************
      subroutine AppendTransformation(MainTransform, Appendix)
      real	MainTransform(4,4)	! the transformation to be appended to
      real	Appendix(4,4)		! the transformation to be appended
      
      real	Temp(4,4)		! temporary matrix holder
      integer	Error			! error indicator
      integer	I, J			! loop control variables
      
      call pcom3(Appendix, MainTransform, Error, Temp)
      do I=1,4					! \
	  do J=1,4				!  \  Copy the result matrix
	      MainTransform(I,J)=Temp(I,J)	!   > back into the first
	  end do				!  /  argument matrix.
      end do					! /
      return
      end