nameset.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 NameSet				! program "NameSet.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	Name(255)			! name set
      integer*4	Root, Text			! structure names
      parameter	(Root=1, Text=2)		!   (chosen by user)
      integer*4	IncludeSet(10), ExcludeSet(10)	! name set variables
      integer*2	Floor1, Floor2, Floor3, Electrical, Plumbing
      parameter	(Floor1=1, Floor2=2, Floor3=3, Electrical=4, Plumbing=5)
      integer*4	ChoiceStatus, ChoiceNum		! choice status and value
      character*80 Message1, Message2, Message3, Message4
      real	Gray(3), Green(3), Yellow(3)	! for defining colors
      data	Gray   /0.4, 0.4, 0.4/
      data	Green  /0.0, 1.0, 0.0/
      data	Yellow /1.0, 1.0, 0.0/
      integer*4	HighlightIndex, Method		! for setting highlight color
      !--- variables for packing data record ---------------------------------
      integer*4		IntCount		! DataRec Integer count
      integer*4		Ints(1)			! DataRec Integer array
      integer*4		RealCount		! DataRec Real count
      real     		Reals(3)		! max for 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(10)		! DataRec array
      integer*4	Error				! error-return variable
      integer*4 fdopen				! to get file descriptor

      !--- open phigs and workstation  ---------------------------------------
      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 pscr(WorkstnID, 0, 3, Gray)		! set colour representation
      call pscr(WorkstnID, 2, 3, Green)		! set colour representation
      call pscr(WorkstnID, 3, 3, Yellow)	! set colour representation
      call pschm(WorkstnID, 2, PREQU, PNECHO)	! set choice mode
      !--- set up highlight colour -------------------------------------------
      IntCount=1
      Ints(1)=2					! highlight color index
      RealCount=0
      call pprec(IntCount, Ints, RealCount, Reals, StrCount, StrLength,
     +  Strings, RecCount, Error, Length, DataRec)
      HighlightIndex=1				! highlight table entry
      Method=4					! forced highlight method
      call pue200(WorkstnID, HighlightIndex,	! set highlight representation
     +  Method, Length, DataRec)
      !--- text structure for messages ---------------------------------------
      Message1='Initial Values'
      Message2='  Inclusion set: Empty'
      Message3='  Exclusion set: Empty'
      Message4='(press any key to continue)'
      call popst(Text)				! open structure
      call pstxci(2)				! set text colour index
      call psatch(0.02)				! set annotation text height
      call patr(0.05, 0.9,  0.0, 0.0, Message1)	! annotation text relative
      call patr(0.05, 0.85, 0.0, 0.0, Message2)	! annotation text relative
      call patr(0.05, 0.80, 0.0, 0.0, Message3)	! annotation text relative
      call patr(0.05, 0.75, 0.0, 0.0, Message4)	! annotation text relative
      call pclst				! close structure
      !---  open the root structure ------------------------------------------
      call popst(Root)				! open structure
      call pstxfn(2)				! set text font
      !---  create messages and category headings without nameset attributes
      call pexst(Text)				! execute structure
      call pschh(0.05)				! set character height
      call pstxci(2)				! set text color index
      call ptx(0.05, 0.6, 'Electrical')		! text
      call ptx(0.6, 0.6, 'Plumbing')		! text
      call pstxci(3)				! set text color index 3
      !--- create nameset elements for each electrical component -------------
      Name(1)=Electrical
      Name(2)=Floor1
      call pads(2, Name)			! add names to set
      !--- current name set: Electrical, Floor1 ------------------------------
      call ptx(0.05, 0.5, 'Floor 1')		! text
      Name(1)=Floor1
      call pres(1, Name)			! remove name from set
      Name(1)=Floor2
      call pads(1, Name)			! add name to set
      !--- current name set: Electrical, Floor2 ------------------------------
      call ptx(0.05, 0.4, 'Floor 2')		! text
      Name(1)=Floor2
      call pres(1, Name)			! remove name from set
      Name(1)=Floor3
      call pads(1, Name)			! add name to set
      !--- current name set: Electrical, Floor3 ------------------------------
      call ptx(0.05, 0.3, 'Floor 3')		! text
      Name(1)=Electrical
      call pres(1, Name)			! remove name from set
      !--- current name set: Floor3 ------------------------------------------
      !--- create nameset attribute elements for each plumbing component -----
      Name(1)=Plumbing
      call pads(1, Name)			! add Plumbing to name set
      !--- current name set: Plumbing, Floor3 --------------------------------
      call ptx(0.6, 0.3, 'Floor 3')		! text
      Name(1)=Floor3
      call pres(1, Name)			! remove Floor3 from name set
      Name(1)=Floor2
      call pads(1, Name)			! add Floor2 to name set
      !--- current name set: Plumbing, Floor2 --------------------------------
      call ptx(0.6, 0.4, 'Floor 2')		! text
      Name(1)=Floor2
      call pres(1, Name)			! remove Floor2 from name set
      Name(1)=Floor1
      call pads(1, Name)			! add Floor1 to name set
      !--- current name set: Plumbing, Floor1 --------------------------------
      call ptx(0.6, 0.5, 'Floor 1')		! text
      call pclst				! close structure
      !--- close the structure and post it to the workstation  ---------------
      call ppost(WorkstnID, Root, 1.0)		! post structure
      call prst(WorkstnID, 1)			! redraw all structures
      call prqch(WorkstnID, 2, ChoiceStatus, ChoiceNum)	! request choice
      !--- highlight electrical on floors 1 and 3  ---------------------------
      IncludeSet(1)=Electrical
      ExcludeSet(1)=Plumbing
      ExcludeSet(2)=Floor2
      !--- set highlighting filter  ------------------------------------------
      call pshlft(WorkstnID, 1, IncludeSet,	! set highlighting filter
     +  2, ExcludeSet)
      !--- replace text primitives in the text structure ---------------------
      Message1='Highlight filter'
      Message2='  Inclusion set: Electrical'
      Message3='  Exclusion set: Plumbing, Floor2'
      call psedm(PREPLC)			! set edit mode
      call popst(Text)				! open the structure
      call psep(3)				! set element pointer
      call patr(0.05, 0.9, 0.0, 0.0, Message1)	! annotation text relative
      call psep(4)				! set element pointer
      call patr(0.05, 0.85, 0.0, 0.0, Message2)	! annotation text relative
      call psep(5)				! set element pointer
      call patr(0.05, 0.80, 0.0, 0.0, Message3)	! annotation text relative
      call pclst()				! close structure
      !--- redraw all structures and request choice --------------------------
      call prst(WorkstnID, 1)			! redraw all structures
      call prqch(WorkstnID, 2, ChoiceStatus, ChoiceNum)	! request choice
      !--- clear the highlighting filter  ------------------------------------
      call pshlft(WorkstnID, 0, IncludeSet,	! set highlighting filter
     +  0, ExcludeSet)
      !--- make electrical and plumbing on floors 2 and 3 invisible. ---------
      IncludeSet(1)=Electrical
      IncludeSet(2)=Plumbing
      ExcludeSet(1)=Floor1
      !--- set invisibility filter  ------------------------------------------
      call psivft(WorkstnID, 2, IncludeSet,	! set invisibility filter
     +  1, ExcludeSet)
      !--- replace text primitives in the text structure ---------------------
      Message1='Invisibility filter'
      Message2='Inclusion set: Floor2, Floor3, Electrical, Plumbing'
      Message3='Exclusion set: Floor1'
      call popst(Text)				! open the structure
      call psep(3)				! set element pointer
      call patr(0.05, 0.9, 0.0, 0.0, Message1)
      call psep(4)				! set element pointer
      call patr(0.05, 0.85, 0.0, 0.0, Message2)
      call psep(5)				! set element pointer
      call patr(0.05, 0.80, 0.0, 0.0, Message3)
      call pclst()				! close structure
      !--- redraw all structures and request choice -------------------------
      call prst(WorkstnID, 1)
      call prqch(WorkstnID, 2, ChoiceStatus, ChoiceNum)	! request choice
      call pupast(WorkstnID)			! unpost all structures
      call puwk(WorkstnID, PPERFO)		! update workstation
      call pclwk(WorkstnID)			! close workstation
      call pclph				! close phigs
      stop
      end