colourwheel.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 ColourWheel			! program "ColourWheel.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	Direct				! mnemonic tokens
      parameter	(Direct=0)			! sent to "pue250"
      integer*4	Structure			! structure identifier
      parameter (Structure=1)			! value chosen by the user
      integer*4	Sections			! number of sections in the...
      parameter	(Sections=50)			!   ...circle of colour wheel
      real	X(3), Y(3), Z(3)		! for the triangles
      integer*4	Error				! error-return variable
      integer*4	Dummy(1)			! dummy variable/place holder
      real	Colour(9), HSVRGB(360, 3)	! colour storage areas
      integer*4	LastVerts(1)			! sent to "pfasd3"
      data	LastVerts /3/			! all polygons are triangles
      integer*4	BoldSansSerif			! mnemonic token
      parameter	(BoldSansSerif=-6)		! sent to "pstxfn"
      real	Theta, dTheta			! loop control variables
      character*7 Labels(6)			! for labelling the wheel
      data	Labels /"0/6,6/6", "  1/6", "  2/6",
     +			"  3/6",   "  4/6", "  5/6"/
      real	xform(4, 4)			! for transformations
      integer*4	I, J				! loop control variables
      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, Direct)		! set colour environment
      !--- calculate RGB representations of HSV colours ----------------------
      Theta=0.					! beginning angle
      dTheta=360./Sections			! angular width of each piece
      do I=1,Sections
	  call pscmd(WorkstnID, PHSV)		! set colour model to HSV
          Colour(1)=Theta/360.			! \
          Colour(2)=1.				!  > fully saturated, luminous
          Colour(3)=1.				! /
          call pscr(WorkstnID, 2, 3, Colour)	! set colour as HSV
          call pscmd(WorkstnID, PRGB)		! set colour model back to RGB
          call pqcr(WorkstnID, 2, 3, PREALI,	! retrieve the colour just
     +      Error, Dummy(1), Colour)		!   set, but now it's in RGB
          do J=1, 3
              HSVRGB(I, J)=Colour(J)		! store RGB rep. of HSV colour
          end do
          Theta=Theta+dTheta			! increment angle
      end do
      !=== define the color-wheeel structure =================================
      call popst(Structure)			! open structure
      call psis(PSOLID)				! set interior style
      call psism(PCIS)				! set interior shading method
      !--- draw the piece-of-pie-shaped segments -----------------------------
      Theta=0.					! beginning angle
      X(1)=0.					! \
      Y(1)=0.					!  > point 1: center of circle
      Z(1)=0.					! /
      Colour(1)=1.0				! \
      Colour(2)=1.0				!  > center is white (in RGB)
      Colour(3)=1.0				! /
      do I=1, Sections
          X(2)=cos(rad(90-Theta))		! \
          Y(2)=sin(rad(90-Theta))		!  > point 2: on perimeter
          Z(2)=0.				! /
          do J=1, 3
              Colour(J+3)=HSVRGB(I, J)		! use this calculated colour
          end do
          X(3)=cos(rad(90-(Theta+dTheta)))	! \
          Y(3)=sin(rad(90-(Theta+dTheta)))	!  > point 3: on perimeter
          Z(3)=0.				! /
          if (I .lt. Sections) then
              do J=1, 3
                  Colour(J+6)=HSVRGB(I+1, J)	! use next calculated colour
              end do
          else
              do J=1, 3
                  Colour(J+6)=HSVRGB(1, J)	! use first calculated colour
              end do
          end if
          call psc3(.45, .45, .45, Error, xform)! scale 3
          call pslmt3(xform, PCREPL)		! set local transformation 3
          call ptr3(.5, .5, .5, Error, xform)	! translate 3
          call pslmt3(xform, PCPOST)		! set local transformation 3
          call pfas3d(				! fill area set with data 3
     +      0,					!   facet flag: none
     +      0,					!   edge flag: none
     +      1,					!   vertex flag: XYZ+RGB
     +      1,					!   colour type: RGB
     +      3,					!   number of colour components
     +      Dummy, Dummy,			!   dummy facet colours
     +      Dummy, Dummy, Dummy,		!   dummy facet normal arrays
     +	    0, Dummy,				!   facet application data
     +      1,					!   1 fill area in this set
     +      LastVerts,				!   index of last vertex
     +      Dummy,				!   dummy edge array
     +      X, Y, Z,				!   coordinates of triangle
     +      Dummy,				!   dummy colour index array
     +      Colour,				!   vertex colour array
     +      Dummy, Dummy, Dummy,		!   dummy vertex normal arrays
     +	    0, Dummy)				!   vertex application data
          Theta=Theta+dTheta			! increment angle
      end do
      !--- do the labels around the perimeter of the wheel -------------------
      call pstxfn(BoldSansSerif)		! set text font
      call pschh(.05)				! set character height
      call pstxal(PACENT, PAHALF)		! set text alignment
      do I=1, 6
          call ptx(				! text
     +      1.08*cos(rad(90-(I-1)*60.)), 1.08*sin(rad(90-(I-1)*60.)),
     +      Labels(I))
      end do
      call pclst				! close structure
      call ppost(WorkstnID, Structure, 1.)	! mark structure for display
      call prst(WorkstnID, PALWAY)
      call pclwk(WorkstnID)			! close workstation
      call pclph				! close phigs
      stop					! stop processing
      end					! end of program