Functions and subroutines within this library:
asfset asfint intinhEnd of directory
C *********************************************************
C * *
C * SUBROUTINE 04.03.01/asfset *
C * *
C * PHIGS Validation Tests, produced by NIST *
C * *
C *********************************************************
SUBROUTINE ASFSET (ASFIX, ASFTAB, START, END)
C ASFSET is used to set a sequence of ASFs to values specified in
C an indicated row of the ASF table.
C Input parameters:
C ASFIX : the row (1-5) of the table from which values are taken
C ASFTAB : table containing ASF values
C START,END : first,last column in the table (corresponding to aspect
C identifier) from which values are taken.
C aspect identifier
INTEGER PLN, PEDCI
PARAMETER (PLN = 0, PEDCI=17)
INTEGER ASFIX, IX, START, END, ASFTAB(5, PLN:PEDCI)
DO 100 IX = START,END
CALL PSIASF (IX, ASFTAB(ASFIX, IX))
100 CONTINUE
END
C *********************************************************
C * *
C * SUBROUTINE 04.03.01/asfint *
C * *
C * PHIGS Validation Tests, produced by NIST *
C * *
C *********************************************************
SUBROUTINE ASFINT (VIS, VISI, VICI, NUMLIN, NGPRIM)
C ASFINT draws a set of fill areas and fill area sets to illustrate
C the effect of various interior aspect source flags.
C Input parameters:
C VIS : interior style to be displayed/suppressed
C VISI : interior style index to be displayed/suppressed
C VICI : interior color index to be displayed/suppressed
C NUMLIN : number of primitives to display
C Output parameters:
C NGPRIM : which primitive is drawn differently
COMMON /GLOBNU/ CTLHND, ERRSIG, ERRFIL, IERRCT, UNERR,
1 TESTCT, IFLERR, PASSSW, ERRSW, MAXLIN,
2 CONID, MEMUN, WKID, WTYPE, GLBLUN, INDLUN,
3 DUMINT, DUMRL
INTEGER CTLHND, ERRSIG, ERRFIL, IERRCT, UNERR,
1 TESTCT, IFLERR, PASSSW, ERRSW, MAXLIN,
2 CONID, MEMUN, WKID, WTYPE, GLBLUN, INDLUN,
3 DUMINT(20), ERRIND
REAL DUMRL(20)
C aspect identifier
INTEGER PTXCI, PIS, PISI, PICI, PEDFG
PARAMETER (PTXCI=10, PIS =11, PISI =12, PICI =13, PEDFG=14)
C aspect source
C bundled individual
INTEGER PBUNDL, PINDIV
PARAMETER (PBUNDL = 0, PINDIV = 1)
C interior style
INTEGER PHOLLO, PSOLID, PPATTR, PHATCH, PISEMP
PARAMETER (PHOLLO=0, PSOLID=1, PPATTR=2, PHATCH=3, PISEMP=4)
C off/on switch for edge flag and error handling mode
INTEGER POFF, PON
PARAMETER (POFF = 0, PON = 1)
C aspect visibility
INTEGER DISPLY, SUPPRS
PARAMETER (DISPLY = 0, SUPPRS = 1)
INTEGER VIS (DISPLY:SUPPRS), NPTS(1), IBSW, IPRIM, NEXT
INTEGER VISI (DISPLY:SUPPRS), VICI (DISPLY:SUPPRS)
INTEGER IX, NUMLIN,NGPRIM, RNDINT, STYSRC,IIXSRC,COLSRC
INTEGER P1(10),P2(10),P3(10)
REAL XA(10),YA(10),ZA(10), YTOP,YLOC,YINCR
C use IBSW to switch individual/bundled
IBSW = PINDIV+PBUNDL
C primitive to be drawn incorrectly
NGPRIM = RNDINT (1,NUMLIN)
YINCR = 1.0 / (NUMLIN+1)
YTOP = 1-YINCR
YLOC = YTOP
CALL NUMLAB (NUMLIN, 0.15, YTOP, YINCR)
IPRIM = 1
XA(1) = 0.2
XA(2) = 0.2
XA(3) = 0.8
XA(4) = 0.8
ZA(1) = 0.5
ZA(2) = 0.5
ZA(3) = 0.5
ZA(4) = 0.5
C set edge flag = OFF
CALL PSIASF (PEDFG, PINDIV)
CALL PSEDFG (POFF)
NPTS(1) = 4
C ensure both individual and bundle are picked for each aspect
CALL RNPERM (NUMLIN, P1)
CALL RNPERM (NUMLIN, P2)
CALL RNPERM (NUMLIN, P3)
C loop to draw primitives
DO 100 IX = 1,NUMLIN
C randomly pick source for aspects:
STYSRC = MOD (P1(IX), 2)
IIXSRC = MOD (P2(IX), 2)
COLSRC = MOD (P3(IX), 2)
C set bundle #ix to displayed aspects, for BUNDLED source
C and suppressed aspects, for INDIVIDUAL source
CALL PSIR (WKID, IX, VIS(STYSRC), VISI(IIXSRC), VICI(COLSRC))
CALL PSII (IX)
C set individual attributes
C to displayed aspects, for INDIVIDUAL source
C and suppressed aspects, for BUNDLED source
CALL PSIS (VIS (IBSW-STYSRC))
CALL PSISI (VISI(IBSW-IIXSRC))
CALL PSICI (VICI(IBSW-COLSRC))
C set ASF flags in accordance with: stysrc, iixsrc, colsrc
CALL PSIASF (PIS, STYSRC)
CALL PSIASF (PISI, IIXSRC)
CALL PSIASF (PICI, COLSRC)
IF (IX .EQ. NGPRIM) THEN
C set ASF flag NOT in accordance with typsrc
CALL PSIASF (PIS, IBSW-STYSRC)
CALL PSIASF (PISI, IBSW-IIXSRC)
CALL PSIASF (PICI, IBSW-COLSRC)
NEXT = IPRIM
ELSE
NEXT = IPRIM+1
ENDIF
YA(1) = YLOC + 0.3*YINCR
YA(2) = YLOC - 0.3*YINCR
YA(3) = YLOC - 0.3*YINCR
YA(4) = YLOC + 0.3*YINCR
IF (IPRIM .EQ. 1) THEN
CALL PFA (4, XA,YA)
ELSEIF (IPRIM .EQ. 2) THEN
CALL PFA3 (4, XA,YA,ZA)
ELSEIF (IPRIM .EQ. 3) THEN
CALL PFAS (1, NPTS, XA,YA)
ELSEIF (IPRIM .EQ. 4) THEN
CALL PFAS3 (1, NPTS, XA,YA,ZA)
ELSE
CALL PFA (4, XA,YA)
ENDIF
YLOC = YLOC-YINCR
IPRIM = NEXT
C next ix
100 CONTINUE
END
C *********************************************************
C * *
C * SUBROUTINE 04.03.01/intinh *
C * *
C * PHIGS Validation Tests, produced by NIST *
C * *
C *********************************************************
SUBROUTINE INTINH (ASFTAB, START, END, PERM)
C INTINH creates the structure network for testing interior ASFs.
C Input parameters:
C ASFTAB : table containing ASF values
C START,END : first,last column in the table (corresponding to aspect
C identifier) from which values are taken.
C Output parameters:
C PERM : permutation of locations used for structure network
C aspect identifier
INTEGER PLN, PEDFG, PEDCI
PARAMETER (PLN = 0, PEDFG=14, PEDCI=17)
C aspect source
C bundled individual
INTEGER PBUNDL, PINDIV
PARAMETER (PBUNDL = 0, PINDIV = 1)
C composition type
C preconcatenate postconcatenate replace
INTEGER PCPRE, PCPOST, PCREPL
PARAMETER (PCPRE = 0, PCPOST = 1, PCREPL = 2)
C off/on switch for edge flag and error handling mode
INTEGER POFF, PON
PARAMETER (POFF = 0, PON = 1)
INTEGER START,END, ASFTAB(5, PLN:PEDCI), PERM(14), ERRIND
INTEGER IX, EXPDX(14), SIZ
REAL XACT(4),XEXP(4),XFORM(3,3), YLOCEL
C x-location of actual/expected interiors
CALL SETRVS ('0.2,0.2,0.5,0.5', XACT, SIZ)
CALL SETRVS ('0.6,0.6,0.9,0.9', XEXP, SIZ)
C randomize order of interiors
CALL RN1SHF (14, PERM)
C set edge flag = OFF
CALL PSIASF (PEDFG, PINDIV)
CALL PSEDFG (POFF)
C set up CSS as described above
CALL LOCINT (PERM(1), XACT)
CALL PEXST (102)
CALL LOCINT (PERM(9), XACT)
CALL ASFSET (2, ASFTAB, START,END)
CALL LOCINT (PERM(10), XACT)
CALL XFINH (PERM)
C execute 104
CALL PEXST (104)
C now, cancel out transformation ...
CALL IDMAT (3, XFORM)
CALL PSLMT (XFORM, PCREPL)
CALL LOCINT (PERM(13), XACT)
CALL LOCINT (PERM(14), XACT)
CALL PEXST (105)
CALL PCLST
C structure #102
CALL POPST (102)
CALL LOCINT (PERM(2), XACT)
CALL ASFSET (3, ASFTAB, START,END)
CALL PEXST (103)
CALL LOCINT (PERM(8), XACT)
CALL PCLST
C structure #103
CALL POPST (103)
CALL LOCINT (PERM(3), XACT)
CALL ASFSET (4, ASFTAB, START,END)
CALL LOCINT (PERM(4), XACT)
CALL PEXST (104)
CALL LOCINT (PERM(7), XACT)
CALL PCLST
C structure #104
CALL POPST (104)
C polymarker 5 / 11
CALL LOCINT (PERM(5), XACT)
CALL ASFSET (5, ASFTAB, START,END)
C polymarker 6 / 12
CALL LOCINT (PERM(6), XACT)
CALL PCLST
C Expected attributes: structure #105
CALL POPST (105)
C values for expected ASFs:
CALL SETVAL ('1,1,3,4,4,5,4,3,1,2,2,5,2,4', EXPDX)
DO 400 IX =1,14
CALL ASFSET (EXPDX(IX), ASFTAB, START,END)
CALL LOCINT (PERM(IX), XEXP)
400 CONTINUE
C draw labels
CALL NUMLAB (14, 0.15, YLOCEL(1), 1.0/15)
CALL PCLST
END