$alias fdopen='fdopen'(%val, %ref)      include 'phigs.f1.h'			! get the HP-PHIGS aliases      program PickBox				! program "PickBox.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	Error				! error-return variable      integer*4	SpecType			! specific workstation type       integer*4	UnitType			! device unit type      integer*4	Root, LineSquare, Trans1, Trans2! structure IDs      parameter (Root=2, LineSquare=1, Trans1=3, Trans2=4)      real	AreaX(4), AreaY(4)		! points for fill area       data	AreaX /0.0, 0.0, 0.2, 0.2/, AreaY /0.0, 0.2, 0.2, 0.0/      real	LineX(2), LineY(2)		! points for polyline       data	LineX /0.2, 0.4/, LineY /0.1, 0.1/      integer*4	PixelsX, PixelsY, PixelsZ	! display space size in pixels      real	DCsX, DCsY, DCsZ		! display space size in DCs      real	EchoVolume(6)			! Echo volume limits      !--- picking variables -------------------------------------------------      integer*4	Pointer				! pointer device number      parameter (Pointer=1)      integer*4	PET				! prompt/echo type      integer*4	PathDepth			! input pick path depth      parameter(PathDepth=5)			! input pick path value      integer*4	PickPath(3, PathDepth)		! PickPath array      integer*4	PickStatus			! return pick status      integer*4	ReturnDepth			! return pick path depth      integer*4	Incl(2), Excl(2)		! include and exclude filters      integer*4	NameList(255)			! namelist array for name sets      integer*4 Name1				! a name for the namelist      parameter (Name1=1)      !-- variables for packing the data record ------------------------------      integer*4		IntCount		! DataRec integer count      parameter		(IntCount=1)		! DataRec integer count value      integer*4		Ints(IntCount)		! DataRec integer array      integer*4		RealCount		! DataRec real count      parameter		(RealCount=3)		! DataRec real count value      real		Reals(RealCount)	! DataRec real array      integer*4		StrCount		! DataRec string count      parameter		(StrCount=0)		! DataRec string count value      integer*4		StrLength		! DataRec string length      parameter		(StrLength=1)		! DataRec string length value      character*1	Strings(1)		! DataRec string array      integer*4		RecCount		! DataRec element count      parameter		(RecCount=1)		! DataRec element count value      integer*4		Length			! DataRec element return length      character*80	DataRec(RecCount)	! DataRec array      !--- miscellaneous items -----------------------------------------------      integer*4 fdopen				! to get file descriptor      real	Matrix(3, 3)			! transformation matrix      logical	Done				! loop control variable      integer*4	Index				! loop control variable      real	rad, degrees      rad(degrees)=(degrees*3.14159265358979323846/180.0)      !=== initialize ========================================================      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      !--- define the structure with the line and square ---------------------      call popst(LineSquare)		! open structure       call ppl(2, LineX, LineY)		! polyline      call psis(PSOLID)			! set interior style: solid       call pfa(4, AreaX, AreaY)		! fill area          call pclst			! close structure       !--- define first transformation structure -----------------------------      call popst(Trans1)		! open structure      call pbltm(0.0, 0.0, 0.2, 0.2, 	! build local transformation matrix     +  rad(0.0), 1.0, 1.0, Error, Matrix)      call pslmt(Matrix, PCREPL)	! set local modelling transformation      call pexst(LineSquare)		! execute structure      call pclst			! close structture      !--- build second transformation structure -----------------------------      call popst(Trans2)		! open structure      call pbltm(0.0, 0.0, 0.8, 0.8, 	! build local transformation matrix     +  rad(180.0), 1.0, 1.0, Error, Matrix)      call pslmt(Matrix, PCREPL)	! set local modelling transformation      call pexst(LineSquare)		! execute structure      call pclst			! close structure      !--- build root structure ----------------------------------------------      call popst(Root)			! open structure       Namelist(1)=Name1			! put Name 1 in array      call pads(1, NameList)		! add names to set      call pspkid(1)			! set pick id      call pexst(Trans1)		! execute transformation one      call pexst(Trans2)		! execute transformation two      call pbltm(0.0, 0.0, 0.2, 0.8, 	! build local transformation matrix     +  rad(-90.0), 1.0, 1.0, Error, Matrix)      call pslmt(Matrix, PCREPL)	! set local modelling transformation      call pspkid(2)			! set pick identifier      call pexst(LineSquare)		! execute structure      call pbltm(0.0, 0.0, 0.8, 0.2, 	! build local transformation matrix     +  rad(90.0), 1.0, 1.0, Error, Matrix)      call pslmt(Matrix, PCREPL)	! set local modelling transformation      call pexst(LineSquare)		! execute LineSquare      call pclst			! close the structure      !=== display the structure network =====================================      call ppost(WorkstnID, Root, 1.0)      call prst(WorkstnID, PALWAY)      call pqwkc(WorkstnID, Error,	! get specific workstation type     +  ConnID, SpecType)      call pqdsp3(SpecType, Error,	! inquire display size     +  UnitType, DCsX, DCsY, DCsZ, PixelsX, PixelsY, PixelsZ)      EchoVolume(1)=DCsX*0.0		! \      EchoVolume(2)=DCsX*1.0		!  \      EchoVolume(3)=DCsY*0.0		!   > this must be specified,      EchoVolume(4)=DCsY*1.0		!  /  though it is ignored      EchoVolume(5)=DCsZ*0.0		! /      EchoVolume(6)=DCsZ*1.0		!/      !--- pack pick aperture size into data record --------------------------      Reals(1)=0.005      Reals(2)=0.005      Reals(3)=2.0      Ints(1)=2      call pprec(IntCount, Ints, RealCount, Reals,      +  StrCount, StrLength, Strings, RecCount, Error, Length, DataRec)      PickStatus=PNPICK      PET=1      call pinpk3(WorkstnID, Pointer, PickStatus, PathDepth, PickPath,      + 	PET, EchoVolume, Length, DataRec, PPOTOP)      Incl(1)=Name1			! put Name 1 into the pick filter      call pspkft(WorkstnID, Pointer, 1, Incl, 0, Excl)      print *, "Ready for pick input; click on the background (or press"      print *, "the [Break] key) to quit."      Done=.false.      do while (.not. Done)          call prqpk(WorkstnID, Pointer, PathDepth,      +	    PickStatus, ReturnDepth, PickPath)          if (PickStatus .eq. POK) then	! print pick path	      print *, "ReturnDepth: ", ReturnDepth	      do Index=1, ReturnDepth		  print *, "  Structure No.:   ", PickPath(1, Index) 		  print *, "    Pick ID:       ", PickPath(2, Index) 		  print *, "    Element Offset:", PickPath(3, Index)	      end do	  else              print *, "PickStatus:", PickStatus,"; terminating."              Done=.true.          endif      end do      call pclwk(WorkstnID)			! close workstation      call pclph				! close phigs      stop					! stop processing      end					! end of program