clip.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 Clip				! program "Clip.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	TheCurve			! display list structure root
      parameter (TheCurve=1)			! value chosen by the user
      real	X(100), Y(100)			! points for polyline
      integer*4	SimplexSansSerif		! sent to "pstxfn"
      parameter	(SimplexSansSerif=-2)
      integer*4	BoldSansSerif			! sent to "pstxfn"
      parameter	(BoldSansSerif=-4)
      integer*4	I				! loop control variable
      integer*4 fdopen				! to get file descriptor

      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 DefineView(WorkstnID, 1,		! mapping for view index 1:
     + 0., 1., 0., 1.,				!   window: 0-1, 0-1
     + .12, .98, .1, .88,			!   viewport: in a subset
     + .false.)					!   don't clip at view window
      call DefineView(WorkstnID, 2,		! mapping for view index 2:
     + 0., 1., 0., 1., 0., 1., 0., 1.,		!   window & viewpt: 0-1, 0-1
     + .true.)					!   clip at view window
      call DefineView(WorkstnID, 3,		! mapping for view index 3:
     + 0., 1., 0., 1.,				!   window: 0-1, 0-1
     + .12, .98, .1, .88,			!   viewport: in a subset
     + .true.)					!   clip at view window
      call popst(TheCurve)			! open display list structure
      !=== create the labels ==========================================+======
      call psvwi(2)				! set view index to 2
      !--- do the main title ------------------------------------------+------
      call pstxfn(BoldSansSerif)		! set text font
      call pstxal(PACENT, PATOP)		! text alignment: center, top
      call pschh(.05)				! set character height in TLCs
      call pschsp(0.)				! set character spacing
      call ptx(.5, 1., 'VOLTAGE VARIANCE')	! define the text
      !--- do the x-axis title ----------------------------------------+------
      call pstxfn(SimplexSansSerif)		! set text font
      call pstxal(PACENT, PABOTT)		! text alignment: center,bottom
      call pschh(.03)				! set character height in TLCs
      call ptx(.5, 0., 'Time (seconds)')	! define the text
      !--- do the y-axis title ----------------------------------------+------
      call pschup(-1., 0.)			! up vector straight left
      call pstxal(PACENT, PATOP)		! text alignment: center, top
      call ptx(0., .5, 'Voltage')		! define the text
      !=== graph the data =============================================+======
      call psvwi(1)				! set view index to 1
      call DefineRectangle(0., 1., 0., 1.)	! frame the viewport
      open(unit=9, file='data')			! open the data file
      do I=1, 100				! for each point...
	  read(9, *, end=20) X(I), Y(I)		! read the X, Y values
      end do
   20 close(9)					! close the data file
      call ppl(100, X, Y)			! polyline with 100 points
      !--- define the tic marks ---------------------------------------+------
      call psvwi(3)				! set view index to 3
      call DefineTics('X', 0., 0., 1., .01, .01, 5)
      call DefineTics('X', 1., 0., 1., .01, .01, 5)
      call DefineTics('Y', 0., 0., 1., .01, .01, 5)
      call DefineTics('Y', 1., 0., 1., .01, .01, 5)
      call pclst				! close display list structure
      !--- post the image and close up shop ----------------------------------
      call ppost(WorkstnID, TheCurve, 1.0)	! 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
!******************************************************************************
      subroutine DefineView(WorkstnID, ViewIndex,
     +  Wxmin, Wxmax, Wymin, Wymax, Vxmin, Vxmax, Vymin, Vymax,
     +  ClipAtWindow)
      include 'phigs.f2.h'			! get the HP-PHIGS constants
      integer*4	WorkstnID			! workstation identifier
      integer*4	ViewIndex			! the view being defined
      real	Wxmin, Wxmax, Wymin, Wymax	! view window limits
      real	Vxmin, Vxmax, Vymin, Vymax	! projection viewport limits
      logical	ClipAtWindow			! window (or display surface?)
      
      integer*4	ErrorReturn			! error return variable
      real	WindowLimits(4)			! window limits as passed in
      real	ViewportLimits(4)		! viewport limits as passed in
      real	ClipLimits(4)			! clip limits (set to viewport)
      real	ViewMappingMatrix(3,3)		! view mapping matrix
      real	Identity(3,3)			! default view orient. matrix
      data	Identity /1., 0., 0.,
     +			  0., 1., 0.,
     +			  0., 0., 1./
      
      WindowLimits(1)=Wxmin			! \
      WindowLimits(2)=Wxmax			!  \  put individual values
      WindowLimits(3)=Wymin			!  /  into a "limits" array
      WindowLimits(4)=Wymax			! /
      ViewportLimits(1)=Vxmin			! \
      ViewportLimits(2)=Vxmax			!  \  put individual values
      ViewportLimits(3)=Vymin			!  /  into a "limits" array
      ViewportLimits(4)=Vymax			! /
      if (ClipAtWindow) then
          ClipLimits(1)=ViewportLimits(1)	! \
          ClipLimits(2)=ViewportLimits(2)	!  \  make the clip limits
          ClipLimits(3)=ViewportLimits(3)	!  /  equal to viewport
          ClipLimits(4)=ViewportLimits(4)	! /
      else
          ClipLimits(1)=0.			! \
          ClipLimits(2)=1.			!  \  make the clip limits
          ClipLimits(3)=0.			!  /  equal to display surface
          ClipLimits(4)=1.			! /
      end if
      call pevmm(WindowLimits, ViewportLimits,	! evaluate view mapping matrix
     + ErrorReturn, ViewMappingMatrix)
      if (ErrorReturn .ne. 0) then		! did we get an error?
	  print *,"Error", ErrorReturn, "occurred during ",
     +     "call to Evaluate View Mapping Matrix (pevmm)."
          stop
      end if
      call psvwr(WorkstnID, ViewIndex,		! set view representation
     + Identity, ViewMappingMatrix,		! view orient., view mapping
     + ClipLimits, PCLIP)			! "PCLIP" = "turn clipping on"
      return					! return to calling context
      end					! end of subroutine
!******************************************************************************
      subroutine DefineRectangle(Xmin, Xmax, Ymin, Ymax)
      real	Xmin, Xmax, Ymin, Ymax		! rectangle's limits
      include 'phigs.f2.h'			! get the HP-PHIGS constants

      real	X(5), Y(5)			! outline of rectangle
      
      X(1)=Xmin					! lower left corner's X value
      Y(1)=Ymin					! lower left corner's Y value
      X(2)=Xmax					! lower right corner's X value
      Y(2)=Ymin					! lower right corner's Y value
      X(3)=Xmax					! upper right corner's X value
      Y(3)=Ymax					! upper right corner's Y value
      X(4)=Xmin					! upper left corner's X value
      Y(4)=Ymax					! upper left corner's Y value
      X(5)=Xmin					! lower left corner's X value
      Y(5)=Ymin					! lower left corner's Y value
      call ppl(5, X, Y)				! polyline
      return					! return to calling context
      end					! end of subroutine
!******************************************************************************
      subroutine DefineTics(Axis, Location, Start, End, Delta, Size,
     + Major)
      character	Axis			! which axis are the tics for?
      real	Location		! where is this line of tics located?
      real	Start			! where do the tics start?
      real	End			! where do they end?
      real	Delta			! draw a tic every how often?
      real	Size			! how big should the tics be?
      integer*4	Major			! how often does a major tic occur?
      integer*4	Tic			! which tic are we on?
      real	X(2), Y(2)		! both ends of a tic mark
      real	CurrentX, CurrentY	! loop control variables
      real	Length			! length of current tic mark

      if ((Axis .eq. 'x') .or. (Axis .eq. 'X')) then
	  CurrentX=Start		! initialize x position
	  Tic=0				! which tic are we on?
	  do while (CurrentX .le. End)
	      if (mod(Tic, Major) .ne. 0) then
		  Length=Size		! short tic...
	      else
		  Length=Size*2.	! ...or long one?
	      endif
	      X(1)=CurrentX		! x location: bottom of tic mark
	      Y(1)=Location-Length	! y location: bottom of tic mark
	      X(2)=CurrentX		! x location: top of tic mark
	      Y(2)=Location+Length	! y location: top of tic mark
	      call ppl(2, X, Y)		! define the tic
	      Tic=Tic+1			! increment the tic counter
	      CurrentX=CurrentX+Delta
	  end do
      else
	  if ((Axis .eq. 'y') .or. (Axis .eq. 'Y')) then
	      CurrentY=Start		! initialize y position
	      Tic=0			! which tic are we on?
	      do while (CurrentY .le. End)
	          if (mod(Tic, Major) .ne. 0) then
		      Length=Size	! short tic...
	          else
		      Length=Size*2.	! ...or long one?
	          endif
	          X(1)=Location-Length	! x location: left end of tic
	          Y(1)=CurrentY		! y location: left end of tic
	          X(2)=Location+Length	! x location: right end of tic
	          Y(2)=CurrentY		! y location: right end of tic
	          call ppl(2, X, Y)	! define the tic
	          Tic=Tic+1		! increment the tic counter
	          CurrentY=CurrentY+Delta
	      end do
          endif
      endif
      return
      end