$alias fdopen='fdopen'(%val, %ref)      include 'phigs.f1.h'			! get the HP-PHIGS aliases      program GrayRamp				! program "GrayRamp.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	SphereStruc, Scene		! structure IDs      parameter	(SphereStruc=1, Scene=2)	!   (chosen by user)      integer*4	LightsOn(3), LightsOff(1)	! light-state variables      data	LightsOn /1, 2, 3/		! all lights on      real	Matrix(4, 4)			! transformation matrix      real	FirstColour(3), LastColour(3)	! for gray-shade ramp      data	FirstColour /0.0, 0.0, 0.0/	! dimmest colour is black      data	LastColour  /1.0, 1.0, 1.0/	! brightest colour is white      real	WeightVector(3)			! for colour->grays      data	WeightVector /0.30, 0.59, 0.11/	! conversion factors      integer*4	Error				! error-return variable      integer*4 fdopen				! to get file descriptor      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 popst(SphereStruc)			! open structure      call CreateSphere(32, 16)			! define the sphere structure      call pclst				! close structure      call DefineLightSources(WorkstnID)	! define all lights      call DefineColourRamp(WorkstnID, FirstColour, LastColour, 101, 1,     +  WeightVector)      call popst(Scene)				! open structure      call pscmi(1)				! set colour mapping index       call psfcm(PBKFC)				! set facet-culling mode: back      call psis(PSOLID)				! set interior style: solid      call psrfm(PADSRM)			! set reflectance model      call psism(PNOIS)				! set interior shading method      call SetReflectanceProperties(WorkstnID,	! insulate user from pprec...     +  1.0, 1.0, 1.0,				!   amb/diff/spec reflections     +  1.0, 1.0, 1.0,				!   specular colour     +  20.0)					!   specular exponent      call pslss(3, LightsOn, 0, LightsOff)	! set light source state      call pbltm3(0.0, 0.0, 0.0,		! build local xform. matrix     +  0.3, 0.7, 0.7,				!   translate     +  rad(-60.0), rad(30.0), rad(-5.0),	!   rotate     +  0.3, 0.3, 0.3,				!   scale     +  Error, Matrix)				!   returned: error, matrix      call pslmt3(Matrix, PCREPL)		! set local transformation      call pexst(SphereStruc)			! execute structure      call psism(PCIS)				! set interior shading method      call pbltm3(0.0, 0.0, 0.0,		! build local xform. matrix     +  0.7, 0.3, 0.3,				!   translate     +  rad(-60.0), rad(30.0), rad(-5.0),	!   rotate     +  0.3, 0.3, 0.3,				!   scale     +  Error, Matrix)				!   returned: error, matrix      call pslmt3(Matrix, PCREPL)		! set local transformation      call pexst(SphereStruc)			! 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!*****************************************************************************      subroutine CreateSphere(Longitudes, Latitudes)      integer*4 Longitudes      integer*4 Latitudes      include 'phigs.f2.h'      !--- arbitrary limit of 50 for number of latitudes and longitudes ------      real	Sphere(3, 50+1, 50+1)      integer*4 Longitude, Latitude, I		! loop control variables      real	Theta, Phi, CosPhi		! working variables      real	PatchX(4), PatchY(4), PatchZ(4)	! fill area coordinates      real	Red(3), LightBlue(3), Colour(3)	! direct RGB polygon colors      data	Red	  /1.0, 0.0, 0.0/	! RGB for red      data	LightBlue /0.0, 0.5, 0.7/	! RGB for a light blue      integer*4	LastVertex			! for fill area set 3 with data      data	LastVertex /4/			! each quad has four verts (!)      integer*4	Dummy				! placeholder for unused vars      real rad, deg      rad(deg)=(deg*3.1415926535897932385/180.0)! convert degrees to radians      !--- define sphere's data base -----------------------------------------      do Longitude=1, Longitudes+1          Theta = 360.0*(Longitude-1)/Longitudes          do Latitude=1, Latitudes+1	      Phi = -89.99+179.98*(Latitude-1)/Latitudes	      CosPhi = cos(rad(Phi))	      Sphere(1, Longitude, Latitude)=CosPhi*cos(rad(Theta))	      Sphere(2, Longitude, Latitude)=CosPhi*sin(rad(Theta))	      Sphere(3, Longitude, Latitude)=sin(rad(Phi))	  end do      end do      !--- create the sphere out of unicolour patches ------------------------      do Latitude = 1, Latitudes	  do Longitude = 1, Longitudes	      PatchX(1) = Sphere(1, Longitude, Latitude)	      PatchY(1) = Sphere(2, Longitude, Latitude)	      PatchZ(1) = Sphere(3, Longitude, Latitude)	      PatchX(2) = Sphere(1, Longitude+1, Latitude)	      PatchY(2) = Sphere(2, Longitude+1, Latitude)	      PatchZ(2) = Sphere(3, Longitude+1, Latitude)	      PatchX(3) = Sphere(1, Longitude+1, Latitude+1)	      PatchY(3) = Sphere(2, Longitude+1, Latitude+1)	      PatchZ(3) = Sphere(3, Longitude+1, Latitude+1)	      PatchX(4) = Sphere(1, Longitude, Latitude+1)	      PatchY(4) = Sphere(2, Longitude, Latitude+1)	      PatchZ(4) = Sphere(3, Longitude, Latitude+1)	      if (mod(ishft((Longitude-1), -1), 2) .eq. 1) then		  do I=1, 3		      Colour(I)=LightBlue(I)		  end do	      else		  do I=1, 3		      Colour(I)=Red(I)		  end do	      end if	      call pfas3d(			! fill area set 3 with data     +		PFC,				!   facet flag: colour     +		PENO,				!   edge flag: none     +		PCDN,				!   vertex flag: coords/norms     +		PRGB, 3,			!   colour type: RGB     +		Dummy,				!   indexed colour     +		Colour,				!   facet colour     +		Dummy, Dummy, Dummy,		!   facet normal     +		Dummy, Dummy,			!   facet application data     +		1,				!   number of fill areas/set     +		LastVertex,			!   how many vertices/polygon?     +		Dummy,				!   edge flags     +		PatchX, PatchY, PatchZ,		!   polygon's geometry     +		Dummy, Dummy,			!   vertex colour     +		PatchX, PatchY, PatchZ,		!   vertex normals     +		Dummy, Dummy)			!   vertex application data	  end do      end do      return      end!*****************************************************************************      subroutine SetReflectanceProperties(WorkstnID, AmbientRefl,     +  DiffuseRefl, SpecRefl, SpecR, SpecG, SpecB, SpecExp)      integer*4	WorkstnID		! workstation ID      real	AmbientRefl		! ambient refl. coefficient (0.0->1.0)      real	DiffuseRefl		! diffuse refl. coefficient (0.0->1.0)      real	SpecRefl		! specular refl coefficient (0.0->1.0)      real	SpecR, SpecG, SpecB	! specular reflection colour      real	SpecExp			! specular exponent ("shininess")      include 'phigs.f2.h'      !--- variables for packing data record ---------------------------------      integer*4		IntCount	! DataRec's integer count      integer*4		Ints(2)		! DataRec's integer array      integer*4		RealCount	! DataRec's real count      real		Reals(8)	! max needed for DataRec's real array      integer*4		StrCount	! DataRec's string count      integer*4		StrLength	! DataRec's string length      character*1	Strings(1)	! DataRec's string array      integer*4		RecCount	! DataRec's element count      data		StrCount /0/, StrLength /0/, RecCount /8/      integer*4		Length		! DataRec's element return length      character*80	DataRec(8)	! DataRec array itself      integer*4		Error		! error-return variable      IntCount=2			! two significant integers in array      Ints(1)=PRGB			! specify colour as RGB      Ints(2)=3				! RGBs have 3 components      RealCount=7			! seven significant reals in array      Reals(1)=AmbientRefl		! \      Reals(2)=DiffuseRefl		!  \      Reals(3)=SpecRefl			!   \      Reals(4)=SpecExp			!    > put single values into array      Reals(5)=SpecR			!   /      Reals(6)=SpecG			!  /      Reals(7)=SpecB			! /      call pprec(IntCount, Ints, RealCount, Reals, StrCount, StrLength,     +  Strings, RecCount, Error, Length, DataRec)      if (Error .ne. 0) print *, "Error", Error, " in pprec."      call psrfp(PSRPT, Length, DataRec)! set reflectance properties      return      end!*****************************************************************************      subroutine DefineLightSources(WorkstnID)      integer*4 WorkstnID      include 'phigs.f2.h'      call DefineLightSource(WorkstnID, 1,PAMB,	! light source 1: ambient     +  0.4, 0.4, 0.4,				! colour (gray)     +  0.0, 0.0, 0.0,				! position (unused)     +  0.0, 0.0, 0.0,				! direction (unused)     +  0.0, 0.0, 0.0, 0.0)			! conc/spread/atten (unused)      call DefineLightSource(WorkstnID, 2,PDIRE,! light source 2: directional     +  0.8, 0.8, 0.8,				! colour (white, a little dim)     +  0.0, 0.0, 0.0,				! position (unused)     +  10.0, 10.0, -10.0,			! direction     +  0.0, 0.0, 0.0, 0.0)			! conc/spread/atten (unused)      call DefineLightSource(WorkstnID, 3,PDIRE,! light source 3: directional     +  0.7, 0.7, 0.7,				! colour (white, a little dim)     +  0.0, 0.0, 0.0,				! position (unused)     +  -10.0, -10.0, -2.0,			! direction     +  0.0, 0.0, 0.0, 0.0)			! conc/spread/atten (unused)      return      end!*****************************************************************************      subroutine DefineLightSource(WorkstnID, LightNo, LightType,     +  R, G, B, X, Y, Z, dX, dY, dZ, Exponent, Spread, Att1, Att2)      integer*4	WorkstnID		! workstation ID      integer*4	LightNo, LightType	! index and type      real	R, G, B			! colour      real	X, Y, Z			! position (positional)      real	dX, dY, dZ		! direction (all but ambient)      real	Exponent		! concentration exponent (spot)      real	Spread			! spread angle (spot)      real	Att1, Att2		! attenuation factors (pos., spot)      include 'phigs.f2.h'      !--- Variables for packing data record ---------------------------------      integer*4		IntCount	! DataRec's integer count      integer*4		Ints(2)		! DataRec's integer array      integer*4		RealCount	! DataRec's real count      real		Reals(13)	! max needed for DataRec's real array      integer*4		StrCount	! DataRec's string count      integer*4		StrLength	! DataRec's string length      character*1	Strings(1)	! DataRec's string array      integer*4		RecCount	! DataRec's element count      data		StrCount /0/, StrLength /0/, RecCount /8/      integer*4		Length		! DataRec's element return length      character*80	DataRec(8)	! DataRec array itself      integer*4		Error		! error-return variable      IntCount=2			! two significant integers in array      Ints(1)=PRGB			! specify colour as RGB      Ints(2)=3				! RGBs have 3 components      if (LightType .eq. PAMB) then	! if ambient light...	  RealCount=3			! three significant reals in array	  Reals(1)=R			! \	  Reals(2)=G			!  > set ambient light's colour	  Reals(3)=B			! /      endif      if (LightType .eq. PDIRE) then	! if directional light...	  RealCount=6			! six significant reals in array	  Reals(1)=dX			! \	  Reals(2)=dY			!  > set light's direction	  Reals(3)=dZ			! /	  Reals(4)=R			! \	  Reals(5)=G			!  > set directional light's colour	  Reals(6)=B			! /      endif      if (LightType .eq. PPOSI) then	! if positional light...	  RealCount=8			! eight significant reals in array	  Reals(1)=X			! \	  Reals(2)=Y			!  > set light's position	  Reals(3)=Z			! /	  Reals(4)=Att1			! attenuation factor 1	  Reals(5)=Att2			! attenuation factor 2	  Reals(6)=R			! \	  Reals(7)=G			!  > set positional light's colour	  Reals(8)=B			! /      endif      if (LightType .eq. PSPOT) then	! if spotlight...	  RealCount=13			! thirteen significant reals in array	  Reals(1)=X			! \	  Reals(2)=Y			!  > set light's position	  Reals(3)=Z			! /	  Reals(4)=dX			! \	  Reals(5)=dY			!  > set light's direction	  Reals(6)=dZ			! /	  Reals(7)=Exponent		! concentration exponent	  Reals(8)=Att1			! attenuation factor 1	  Reals(9)=Att2			! attenuation factor 2	  Reals(10)=Spread		! spread angle	  Reals(11)=R			! \	  Reals(12)=G			!  > set positional light's colour	  Reals(13)=B			! /      endif      call pprec(IntCount, Ints, RealCount, Reals, StrCount, StrLength,     +  Strings, RecCount, Error, Length, DataRec)      if (Error .ne. 0) print *, "Error", Error, " in pprec."      call pslsr(WorkstnID, LightNo,	! set light source representation     +  LightType, Length, DataRec)      return      end!*****************************************************************************      subroutine DefineColourRamp(WorkstnID, FirstColour, LastColour,     +  RampSize, CMappingIndex, WeightVector)      integer*4	WorkstnID			! workstation identifier      real	FirstColour(3), LastColour(3)	! extremes of ramp      integer*4	RampSize			! size of ramp      integer*4	CMappingIndex			! colour mapping table index      real	WeightVector(3)			! for colour->gray conversion      include 'phigs.f2.h'      !--- Variables for packing data record ---------------------------------      integer*4		IntCount	! DataRec's integer count      integer*4		Ints(3)		! DataRec's integer array      integer*4		RealCount	! DataRec's real count      real		Reals(768)	! max needed for DataRec's real array      integer*4		StrCount	! DataRec's string count      integer*4		StrLength	! DataRec's string length      character*1	Strings(1)	! DataRec's string array      integer*4		RecCount	! DataRec's element count      data		StrCount /0/, StrLength /0/, RecCount /100/      integer*4		Length		! DataRec's element return length      character*80	DataRec(100)	! DataRec array itself      !--- miscellaneous variables -------------------------------------------      real		DeltaColour(3)	! diff. between colr(i) and colr(i+1)      integer*4		Error		! error-return variable      integer*4	I			! loop control variable      IntCount=3			! three significant integers in array      Ints(1)=PRGB			! specify colour as RGB      Ints(2)=3				! RGBs have 3 components      Ints(3)=RampSize			! how big is gray ramp?      RealCount=3+3*RampSize		! weight vector plus 3*RampSize      Reals(1)=WeightVector(1)		! \      Reals(2)=WeightVector(2)		!  > assign weight vector      Reals(3)=WeightVector(3)		! /      do I=1, 3	  DeltaColour(I)=(LastColour(I)-FirstColour(I))/(RampSize-1)      end do      do I=0, RampSize-1          Reals(4+I*3)=FirstColour(1)+DeltaColour(1)*I          Reals(5+I*3)=FirstColour(2)+DeltaColour(2)*I          Reals(6+I*3)=FirstColour(3)+DeltaColour(3)*I      end do      call pprec(IntCount, Ints, RealCount, Reals, StrCount, StrLength,     +  Strings, RecCount, Error, Length, DataRec)      if (Error .ne. 0) print *, "Error", Error, " in pprec."      call pscmr(WorkstnID, CMappingIndex, PSUD,! set colour mapping rep.     +  Length, DataRec)      return      end