-+-+-+-+-+-+-+-+ START OF PART 160 -+-+-+-+-+-+-+-+ XC `20 X`09SUBROUTINE PQPAN (STRID,PTHORD,PTHDEP,IPTHSZ,N,ERRIND,OL,APTHSZ,PATHS) X X `20 X `09INTEGER STRID ! structure identifier X `09INTEGER PTHORD ! path order (PPOTOP,PPOBOT) X `09INTEGER PTHDEP ! path depth X INTEGER IPTHSZ ! size of path buffer X `09INTEGER N ! element of the list of paths X `09INTEGER ERRIND ! error indicator X `09INTEGER OL ! number of paths available X `09INTEGER APTHSZ ! actual size of the Nth structure path X `09INTEGER PATHS(2,IPTHSZ)! Nth structure path X X`09 X`09return X`09end Xc-------------------------------------------------------------------- X XC XC INQUIRE PATHS TO DESCENDANTS XC X`09SUBROUTINE PQPDE (STRID,PTHORD,PTHDEP,IPTHSZ,N,ERRIND,OL, X * APTHSZ,PATHS) X X `20 X `09INTEGER STRID ! structure identifier X `09INTEGER PTHORD ! path order (PPOTOP,PPOBOT) X `09INTEGER PTHDEP ! path depth X `09INTEGER IPTHSZ ! size of path buffer X `09INTEGER N ! element of the list of paths X `09INTEGER ERRIND ! error indicator X `09INTEGER OL ! number of paths available X `09INTEGER APTHSZ ! actual size of the Nth structure path X `09INTEGER PATHS(2,IPTHSZ)! Nth structure path X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC INQUIRE INPUT QUEUE OVERFLOW XC X SUBROUTINE PQIQOV (ERRIND,WKID,ICL,IDN) X `20 X `20 X `09INTEGER ERRIND ! error indicator X `09INTEGER WKID ! wor`7Distation identifier X `09INTEGER ICL ! input class X ! (PLOCAT,PSTROK,PVALUA,PCHOIC, X ! PPICK,PSTRIN) X `09INTEGER IDN ! input device number X X X`09EXTERNAL PINQINPUTOVERFLOW X X`09CALL PINQINPUTOVERFLOW(ERRIND,WKID,ICL,IDN) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC INQUIRE ERROR HANDLING MODE XC X`09SUBROUTINE PQERHM (ERRIND,ERHM) X X`09INTEGER ERRIND ! error indicator X`09INTEGER ERHM ! error handling mode (POFF,PON) X X`09EXTERNAL PINQERRORHANDMODE X X`09CALL PINQERRORHANDMODE(ERRIND,ERHM) X X`09return X`09end `20 X `20 $ CALL UNPACK [.FORTRAN.SOURCE.BINDING]FINQPHIGS.FOR;2 2132296843 $ create 'f' XC XC ADD NAMES TO SET XC X X`09SUBROUTINE PADS (N,NAMSET) X X`09INTEGER N`20 X`09INTEGER NAMSET (N) X X`09EXTERNAL pc_addnameset X X`09CALL pc_addnameset(%val(N), NAMSET) X X`09RETURN X X`09END `20 Xc--------------------------------------------------------------------`20 XC XC REMOVE NAMES FROM SET XC`20 X `20 X`09SUBROUTINE PRES (N,NAMSET) X X`09INTEGER N X`09INTEGER NAMSET (N) X X`09EXTERNAL pc_removenameset X X`09CALL pc_removenameset(%val(N), NAMSET) X X`09RETURN X X`09END `20 Xc-------------------------------------------------------------------- `20 XC XC`09OPEN PHIGS XC X SUBROUTINE POPPH (ERRFIL,BUFA) X X INTEGER ERRFIL X INTEGER BUFA X EXTERNAL popenphigs X X Call popenphigs(ERRFIL,%VAL(BUFA)) X X `20 X END X Xc-------------------------------------------------------------------- X XC XC`09CLOSE PHIGS XC X SUBROUTINE PCLPH X X External pclosephigs X X Call pclosephigs() X X Return X END X Xc-------------------------------------------------------------------- X XC XC`09OPEN WORKSTATION XC X`09SUBROUTINE POPWK (WKID,CONID,WTYPE) X X`09INTEGER WKID X`09CHARACTER*(*) CONID X`09INTEGER WYTPE X X`09EXTERNAL pc_openws X X`09CALL pc_openws(%VAL(WKID),CONID,%VAL(WTYPE)) X X`09RETURN X`09END Xc-------------------------------------------------------------------- X XC XC`09CLOSE WORKSTATION XC X`09SUBROUTINE PCLWK (WKID) X X`09INTEGER WKID X X`09EXTERNAL PCLOSEWS X X`09CALL PCLOSEWS(%val(WKID)) X X`09RETURN X X`09END X X Xc-------------------------------------------------------------------- X XC XC`09REDRAW ALL STRUCTURES XC X`09SUBROUTINE PRST (WKID, COFL) X X`09INTEGER WKID X`09INTEGER COFL X X`09EXTERNAL PREDRAWALLSTRUCT X X`09CALL PREDRAWALLSTRUCT(%VAL(WKID),%VAL(COFL)) X X`09RETURN X X`09END X Xc-------------------------------------------------------------------- X XC XC`09UPDATE WORKSTATION XC X`09SUBROUTINE PUWK (WKID, REGFL) X X`09INTEGER WKID X`09INTEGER REGFL X X`09EXTERNAL PUPDATEWS X X `09CALL PUPDATEWS(%VAL(WKID),%VAL(REGFL)) X X`09RETURN X X`09END Xc-------------------------------------------------------------------- X XC XC`09MESSAGE XC X`09SUBROUTINE PMSG (WKID, MESS) X X`09INTEGER WKID X`09CHARACTER*(*) MESS X X`09EXTERNAL pc_message X X`09CALL pc_message(%VAL(WKID),MESS) X X`09RETURN X X`09END X Xc-------------------------------------------------------------------- X X XC XC EMERGENCY CLOSE PHIGS XC X`09SUBROUTINE PECLPH X X`09EXTERNAL PEMERGENCYCLOSEPHIGS X X`09CALL PEMERGENCYCLOSEPHIGS() X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC ERROR HANDLING XC X`09SUBROUTINE PERHND(ERRNR,FCTID,ERRFIL) X X INTEGER ERRNR ! error number X `09INTEGER FCIID ! function identification X `09CHARACTER*(*) ERRFIL ! error file X X`09EXTERNAL pc_errorhand X X`09CALL pc_errorhand(%VAL(ERRNR),%VAL(FCTID),ERRFIL) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC ERROR LOGGING XC X`09SUBROUTINE PERLOG(ERRNR,FCTID,ERRFIL) X X INTEGER ERRNR ! error number X `09INTEGER FCIID ! function identification X `09CHARACTER*(*) ERRFIL ! error file X X`09EXTERNAL pc_errorlog X X`09CALL pc_errorlog(%VAL(ERRNR),%VAL(FCTID),ERRFIL) X X`09return X`09end Xc-------------------------------------------------------------------- X X XC XC INITIALIZE LOCATOR 3 XC X SUBROUTINE PINLC3(wkid,lcdnr,iviewi,ipx,ipy,ipz,pet, X * evol,ldr,datrec) X X INTEGER WKID ! workstation identifier X INTEGER LCDNR ! locator device number X INTEGER IVIEWI ! initial view index X REAL IPX,IPY,IPZ ! initial locator position (WC) X INTEGER PET ! prompt and echo type X REAL EVOL(6) ! echo volume (DC) X INTEGER LDR ! dimension of data record array X CHARACTER*80 DATREC(*) ! data record X X INTEGER il, ia(10), lstr(10) X INTEGER rl, sl, err X REAL ra(10) X CHARACTER*80 str(10) X X`09EXTERNAL pc_initloc3 X X if (ldr .gt. 0) then X call purec(ldr, datrec, 10, 10, 10, err, il, ia, rl, ra,`20 X : sl, lstr, str) X endif X`09call pc_initloc3(%val(wkid),%val(lcdnr), %val(iviewi), X : ipx, ipy, ipz, %val(pet), evol, ia, ra) X X`09return X`09end X Xc-------------------------------------------------------------------- X XC XC INITIALIZE LOCATOR XC X SUBROUTINE PINLC (WKID,LCDNR,IVIEWI,IPX,IPY,PET,XMIN,XMAX,YMIN, X * YMAX,LDR,DATREC) X X`09INTEGER WKID ! workstation identifier X`09INTEGER LCDNR ! locator device number X`09INTEGER IVIEWI ! initial view index X`09REAL IPX,IPY ! initial locator position (WC) X`09INTEGER PET ! prompt and echo type X`09REAL XMIN,XMAX,YMIN,YMAX ! echo area (DC) X`09INTEGER LDR ! dimension of data record array X`09CHARACTER*80 DATREC(*) ! data record X X INTEGER il, ia(10), lstr(10) X INTEGER rl, sl, err X REAL ra(10) X CHARACTER*80 str(10) X X`09EXTERNAL pc_initloc X X if (ldr .gt. 0) then X call purec(ldr, datrec, 10, 10, 10, err, il, ia, rl, ra,`20 X : sl, lstr, str) X endif X`09CALL pc_initloc(%VAL(WKID),%VAL(LCDNR), %val(IVIEWI), X : IPX, IPY, %VAL(PET), X * XMIN,XMAX,YMIN,YMAX, ia, ra) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC INITIALIZE STROKE 3 XC X`09SUBROUTINE PINSK3 (WKID,SKDNR,IVIEWI,N,IPX,IPY,IPZ,PET,EVOL, X * BUFLEN,LDR,DATREC) X X INTEGER WKID ! workstation identifier X INTEGER IVIEWI ! initial view index X INTEGER n ! number of points X REAL IPX (*), IPY (*), IPZ (*)`20 X ! coordinates of initial stroke (WC) (the actual X ! arguments are dimensioned by at least MAX(1,N)) X INTEGER PET ! prompt and echo type X REAL EVOL(6) ! echo volume (DC) X INTEGER BUFLEN ! input buffer size X INTEGER LDR ! dimension of data record array X CHARACTER*80 DATREC(*) ! data record X X INTEGER il, ia(10), lstr(10) X INTEGER rl, sl, err X REAL ra(10) X CHARACTER*80 str(10) X X`09EXTERNAL pc_initstroke3 X X if (ldr .gt. 0) then X call purec(ldr, datrec, 10, 10, 10, err, il, ia, rl, ra,`20 X : sl, lstr, str) X else X il = 0 X rl = 0 X endif X`09CALL pc_initstroke3(%VAL(WKID), %VAL(SKDNR), %val(IVIEWI), X : %val(N), IPX, IPY, IPZ, %VAL(PET), EVOL, %val(BUFLEN),`20 X : %val(il), ia, %val(rl), ra) X X`09return X`09end X Xc-------------------------------------------------------------------- X XC XC INITIALIZE STROKE XC X`09SUBROUTINE PINSK (WKID,SKDNR,IVIEWI,N,IPX,IPY,PET,XMIN,XMAX, X * YMIN,YMAX,BUFLEN,LDR,DATREC) X X INTEGER WKID ! workstation identifier X INTEGER SKDNR ! stroke device number X INTEGER IVIEWI ! initial view index X INTEGER N ! number of coordinates of initial stro Vke X REAL IPX (*), IPY (*) `20 X ! coordinates of initial stroke (WC) (the actual X ! arguments are dimensioned by at least MAX(1,N)) X INTEGER PET ! prompt and echo type X REAL XMIN,XMAX,YMIN,YMAX ! echo area (DC) X INTEGER BUFLEN ! input buffer size X INTEGER LDR ! dimension of data record array X CHARACTER*80 DATREC(*) ! data record X X INTEGER il, ia(10), lstr(10) X INTEGER rl, sl, err X REAL ra(10) X CHARACTER*80 str(10) X X`09EXTERNAL pc_initstroke X X if (ldr .gt. 0) then X call purec(ldr, datrec, 10, 10, 10, err, il, ia, rl, ra,`20 X : sl, lstr, str) X else X il = 0 X rl = 0 X endif X`09CALL pc_initstroke(%VAL(WKID), %VAL(SKDNR), %val(IVIEWI), X : %val(N), IPX, IPY, X * %VAL(PET), XMIN, XMAX, YMIN, YMAX, X : %val(BUFLEN),%val(il), ia, %val(rl), ra) X X`09return X`09end X Xc-------------------------------------------------------------------- X XC XC INITIALIZE VALUATOR 3 XC X`09SUBROUTINE PINVL3 (WKID,VLDNR,IVAL,PET,EVOL,LOVAL,HIVAL, X : LDR,DATREC) X X`09INTEGER WKID ! workstation identifier X`09INTEGER VLDNR ! valuator device number X`09REAL IVAL ! initial value X`09INTEGER PET ! prompt and echo type X`09REAL EVOL(6) ! echo volume (DC) X REAL LOVAL, HIVAL ! max and min value X`09INTEGER LDR ! dimension of data record array X`09CHARACTER*80 DATREC(*) ! data record X X INTEGER il, ia(10), lstr(10) X INTEGER rl, sl, err X REAL ra(10) X CHARACTER*80 str(10) X X`09EXTERNAL pc_initval3 X X if (ldr .gt. 0) then X call purec(ldr, datrec, 10, 10, 10, err, il, ia, rl, ra,`20 X : sl, lstr, str) X else X il = 0 X rl = 0 X endif X`09CALL pc_initval3(%VAL(WKID),%VAL(VLDNR),IVAL,%VAL(PET), X * EVOL, LOVAL, HIVAL, %val(il), ia, %val(rl), ra) X X`09return X`09end X Xc-------------------------------------------------------------------- X XC XC INITIALIZE VALUATOR XC`20 X`09SUBROUTINE PINVL (WKID,VLDNR,IVAL,PET,LOVAL,HIVAL, X : XMIN,XMAX,YMIN,YMAX,LDR,DATREC) X`09 X`09INTEGER WKID ! workstation identifier X`09INTEGER VLDNR ! valuator device number X`09REAL IVAL ! initial value `20 X`09INTEGER PET ! prompt and echo type X`09REAL XMIN,XMAX,YMIN,YMAX ! echo area (DC) X REAL LOVAL, HIVAL ! max and min value X`09INTEGER LDR ! dimension of data record array X`09CHARACTER*80 DATREC(*) ! data record X X INTEGER il, ia(10), lstr(10) X INTEGER rl, sl, err X REAL ra(10) X CHARACTER*80 str(10) X X`09EXTERNAL pc_initval X X if (ldr .gt. 0) then X call purec(ldr, datrec, 10, 10, 10, err, il, ia, rl, ra,`20 X : sl, lstr, str) X else X il = 0 X rl = 0 X endif X`09CALL pc_initval(%VAL(WKID),%VAL(VLDNR),IVAL,%VAL(PET), X * LOVAL, HIVAL, XMIN,XMAX, X : YMIN,YMAX, %val(il), ia, %val(rl), ra) X X`09return X`09end X Xc-------------------------------------------------------------------- X XC XC INITIALIZE CHOICE 3 XC X`09SUBROUTINE PINCH3 (WKID,CHDNR,ISTAT,ICHNR,PET,EVOL,LDR, X * DATREC) X X INTEGER WKID ! workstation identifier X INTEGER CHDNR ! choice device number X INTEGER ISTAT ! initial status (POK,PNCHOI) X INTEGER ICHNR ! initial choice number X INTEGER PET ! prompt and echo type X REAL EVOL(6) ! echovolume (DC) X INTEGER LDR ! dimension of data record array X CHARACTER*80 DATREC(*) ! data record X X INTEGER il, ia(10), lstr(10) X INTEGER rl, sl, err X REAL ra(10) X CHARACTER*80 str(10) X X`09EXTERNAL pc_initchoice3 X +-+-+-+-+-+-+-+- END OF PART 160 +-+-+-+-+-+-+-+-