triquad.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 TriQuad				! program "TriQuad.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	TheStructure			! display list structure root
      parameter (TheStructure=1)		! value chosen by the user
      integer*4	Longitudes, Latitudes		! sections along equator and...
      parameter	(Longitudes=30, Latitudes=15)	! from pole to pole of sphere
      real	SphereX(31,16), SphereY(31,16), SphereZ(31,16)	! sphere
      real	BeltX(62), BeltY(62), BeltZ(62)	! data points of belt
      real	Black(3), White(3)		! colour arrays to be used
      data	Black /0., 0., 0./		! RGB for black
      data	White /1., 1., 1./		! RGB for white
      real	Dummy(1)			! space filler
      real	Theta, Phi, CosPhi		! working variables
      real	xform(4,4)			! transformation matrix
      integer*4	Longitude, Latitude		! loop control variable
      integer*4	Error				! error-return variable

      real	rad, deg			! type the statement function
      integer*4 fdopen				! to get file descriptor
      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 popst(TheStructure)			! open display list structure
      !-- define the data bases ----------------------------------------------
      do Longitude=1,31
          Theta=360.*(Longitude-1)/30
          do Latitude=1,16
              Phi=-89.99+179.98*(Latitude-1)/Latitudes
              CosPhi=cos(rad(Phi))
              SphereX(Longitude,Latitude)=CosPhi*cos(rad(Theta))
              SphereY(Longitude,Latitude)=CosPhi*sin(rad(Theta))
              SphereZ(Longitude,Latitude)=sin(rad(Phi))
          end do
      end do
      do Longitude=1, 31
          Theta=360.*Longitude/30
          BeltX(2*Longitude-1)=1.4*cos(rad(Theta))
          BeltY(2*Longitude-1)=1.4*sin(rad(Theta))
          BeltZ(2*Longitude-1)=.15
          BeltX(2*Longitude  )=1.4*cos(rad(Theta))
          BeltY(2*Longitude  )=1.4*sin(rad(Theta))
          BeltZ(2*Longitude  )=-.15
      end do
      !-- render the sphere and its encircling belt --------------------------
      call pshrm(WorkstnID, PHRZBF)		! set HLHSR mode: Z buffer
      call psis(PSOLID)				! set interior style: solid
      call psic(1, 0, 3, Black)			! set interior colour: black
      call psedfg(PON)				! set edge flag: on
      call psedc(1, 0, 3, White)		! set edge colour: white
      call prox(rad(110), Error, xform)		! rotate about X axis
      call pslmt3(xform, PCPOST)		! set local transformation
      call proz(rad(-20), Error, xform)		! rotate about Z axis
      call pslmt3(xform, PCPOST)		! set local transformation
      call psc3(.35, .35, .35, Error, xform)	! 3d scale to 35%
      call pslmt3(xform, PCPOST)		! set local transformation
      call ptr3(.5, .5, .5, Error, xform)	! 3d translate .5,.5,.5
      call pslmt3(xform, PCPOST)		! set local transformation
      call pqm3d(				! quadrilateral mesh
     +  PFNO, PENO, PCD,			!   facet-, edge-, vrtx flags
     +  PRGB, 3,				!   colour type/num colr comps
     +  16, 31,					!   array size: <cols>x<rows>
     +  Dummy, Dummy,				!   dummy colour arrays
     +  Dummy, Dummy, Dummy,			!   dummy facet normal arrays
     +  Dummy, Dummy,				!   no facet application data
     +  Dummy,					!   no per-edge data
     +  SphereX, SphereY, SphereZ,		!   XYZ coordinate arrays
     +  Dummy, Dummy,				!   dummy colour arrays
     +  Dummy, Dummy, Dummy,			!   dummy vertex normal arrays
     +  0, Dummy)				!   no vertex application data
      call ptst3d(				! triangular strip
     +  PFNO, PENO, PCD,			!   facet-, edge-, vrtx flags
     +  PRGB, 3,				!   colour type: RGB
     +  62,					!   array size
     +  Dummy, Dummy,				!   dummy colour arrays
     +  Dummy, Dummy, Dummy,			!   dummy facet normal arrays
     +	0, Dummy,				!   no facet application data
     +  Dummy,					!   no edge data
     +  BeltX, BeltY, BeltZ,			!   XYZ coordinate arrays
     +  Dummy, Dummy,				!   dummy colour arrays
     +  Dummy, Dummy, Dummy,			!   dummy vertex normal arrays
     +  0, Dummy)				!   no vertex application data
      call pclst				! close display list structure
      call ppost(WorkstnID, TheStructure, 1.)	! mark structure for display
      call puwk(WorkstnID, PPERFO)		! update the workstation
      call pclwk(WorkstnID)			! close workstation
      call pclph				! close phigs
      stop					! stop processing
      end					! end of program