charlbls.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 CharLbls				! program "CharLbls.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 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
      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