-+-+-+-+-+-+-+-+ START OF PART 161 -+-+-+-+-+-+-+-+ 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_initchoice3(%VAL(WKID),%VAL(CHDNR),%VAL(ISTAT), X * %VAL(ICHNR),%VAL(PET),EVOL, %val(il), ia, %val(rl), ra, X : %VAL(sl), lstr, %REF(str)) X X`09return X`09end X Xc-------------------------------------------------------------------- X XC`20 XC INITIALIZE CHOICE XC X`09SUBROUTINE PINCH (WKID,CHDNR,ISTAT,ICHNR,PET,XMIN,XMAX,YMIN, X * YMAX,LDR,DATREC) X X`09INTEGER WKID ! workstation identifier X`09INTEGER CHDNR ! choice device number X`09INTEGER ISTAT ! initial status (POK,PNCHOI) X`09INTEGER ICHNR ! initial choice number 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_initchoice 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_initchoice(%VAL(WKID),%VAL(CHDNR),%VAL(ISTAT), X * %VAL(ICHNR),%VAL(PET),XMIN,XMAX,YMIN, X : YMAX, %val(il), ia, %val(rl), ra, %val(sl), lstr, %REF(str)) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC INITIALIZE PICK 3 XC `20 X`09SUBROUTINE PINPK3 (WKID,PKDNR,ISTAT,IPPD,PP,PET,EVOL, X * LDR,DATREC,PPORDR) X X`09INTEGER WKID ! workstation identifier X`09INTEGER PKDNR ! pick device number X`09INTEGER ISTAT ! initial status (POK,PNPICK) X`09INTEGER IPPD ! depth of initial pick path X`09INTEGER PP(3,*) ! initial pick path X`09INTEGER PET ! prompt and echo type X`09REAL EVOL(6) ! echo volume (DC) X`09INTEGER LDR ! dimension of data record array X`09CHARACTER*80 DATREC(*) ! data record X`09INTEGER PPORDR ! pick path order (PPOTOP, PPOBOT) 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_initpick3 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_initpick3(%VAL(WKID),%VAL(PKDNR),%VAL(ISTAT), X : %val(IPPD),PP, X * %VAL(PET),EVOL,%val(PPORDR), %val(il), ia, %val(rl), ra) X X`09return X`09end X Xc-------------------------------------------------------------------- X XC XC INITIALIZE PICK XC`20 X`09SUBROUTINE PINPK (WKID,PKDNR,ISTAT,IPPD,PP,PET,XMIN,XMAX, X * YMIN,YMAX,LDR,DATREC,PPORDR) X X`09INTEGER WKID ! workstation identifier X`09INTEGER PKDNR ! pick device number X`09INTEGER ISTAT ! initial status (POK,PNPICK) X`09INTEGER IPPD ! depth of initial pick path X`09INTEGER PP(3,*) ! initial pick path 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`09INTEGER PPORDR ! pick path order (PPOTOP, PPOBOT) 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_initpick X X if (ldr .gt. 0) then `20 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_initpick(%VAL(WKID),%VAL(PKDNR),%VAL(ISTAT), X : %val(IPPD),PP, X * %VAL(PET),XMIN,XMAX,YMIN,YMAX, X : %val(PPORDR), %val(il), ia, %val(rl), ra) X X`09return X`09end X Xc-------------------------------------------------------------------- X XC XC INITIALIZE STRING 3 XC X`09SUBROUTINE PINST3 (WKID,STDNR,LNSTR,ISTR,PET,EVOL, X : BUFLEN,INIPOS,LDR,DATREC) X X`09INTEGER WKID ! workstation identifier X`09INTEGER STDNR ! string device number X`09INTEGER LNSTR ! length of the initial string (--0).`20 X ! The number X ! of characters actually used is the minimum of X ! LNSTR and the length of ISTR. X`09CHARACTER*(*) ISTR ! initial string X`09INTEGER PET ! prompt and echo type X`09REAL EVOL(6) ! echo volume (DC) X INTEGER BUFLEN ! input buffer size X INTEGER INIPOS ! initial cursor position 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_initstring3 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_initstring3(%VAL(WKID),%VAL(STDNR),%VAL(LNSTR), X : ISTR,%VAL(PET), EVOL, %val(BUFLEN), %val(INIPOS), X : %val(il), ia, %val(rl), ra) X X`09return X`09end X Xc-------------------------------------------------------------------- X XC XC INITIALIZE STRING XC X`09SUBROUTINE PINST (WKID,STDNR,LNSTR,ISTR,PET,XMIN,XMAX,YMIN, X * YMAX,BUFLEN,INIPOS,LDR,DATREC) X X`09INTEGER WKID ! workstation identifier X`09INTEGER STDNR ! string device number X`09INTEGER LNSTR ! length of the initial string (20).`20 X ! The number X ! of characters actually used is the minimum of X ! LNSTR and the length of ISTR. X`09CHARACTER*(*) ISTR ! initial string X`09INTEGER PET ! prompt and echo type X`09REAL XMIN,XMAX,YMIN,YMAX ! echo area (DC) X INTEGER BUFLEN ! input buffer size X INTEGER INIPOS ! initial cursor position 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_initstring 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_initstring(%VAL(WKID),%VAL(STDNR),%val(LNSTR), X : ISTR,%VAL(PET), XMIN,XMAX,YMIN,YMAX, X : %val(BUFLEN), %val(INIPOS), %val(il), ia, %val(rl), ra) X X`09return X`09end `20 X Xc-------------------------------------------------------------------- X XC `20 XC REQUEST LOCATOR 3 XC X`09SUBROUTINE PRQLC3 (WKID,LCDNR,STAT,VIEWI,PX,PY,PZ) X X INTEGER WKID ! workstation identifier X`09INTEGER LCDNR ! locator device number X`09INTEGER STAT ! status (PNONE,POK) X INTEGER VIEWI ! view index X REAL PX,PY,PZ ! locator position (WC) X X`09EXTERNAL pc_reqloc3 X X`09CALL pc_reqloc3(%VAL(WKID),%VAL(LCDNR),STAT,VIEWI,PX,PY,PZ) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC REQUEST LOCATOR XC X SUBROUTINE PRQLC (WKID,LCDNR,STAT,VIEWI,PX,PY) X X INTEGER WKID ! workstation identifier X INTEGER LCDNR ! locator device number X`09 INTEGER STAT ! status (PNONE,POK) X INTEGER VIEWI ! view index X REAL PX PY ! locator position (WC) X X`09EXTERNAL pc_reqloc X X`09CALL pc_reqloc(%VAL(WKID),%VAL(LCDNR),STAT,VIEWI,PX,PY) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC REQUEST STROKE 3 XC X`09SUBROUTINE PRQSK3 (WKID,SKDNR,N,STAT,VIEWI,NP,PXA,PYA,PZA) X X `20 X INTEGER WKID ! workstation identifier X INTEGER SKDNR ! stroke device number X INTEGER N ! dimension of arrays for stroke points X INTEGER STAT ! status (PNONE,POK) X INTEGER VIEWI ! view index X INTEGER NP ! number of points X`09REAL PXA(*), PYA(*), PZA(*) ! coordinates of points in stroke (WC) X X`09EXTERNAL pc_reqstroke3 X X`09CALL pc_reqstroke3(%VAL(WKID),%VAL(SKDNR),%val(N),STAT,VIEWI,NP X * ,PXA,PYA,PZA) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC REQUEST STROKE XC X`09SUBROUTINE PRQSK (WKID,SKDNR,N,STAT,VIEWI,NP,PXA,PYA) X X`09INTEGER WKID ! workstation identifier X`09INTEGER SKDNR ! stroke device number X`09INTEGER N ! dimension of arrays for stroke points X`09INTEGER STAT ! status (PNONE,POK) X`09INTEGER VIEWI ! view index X`09INTEGER NP ! number of points `20 X`09REAL PXA(*), PYA(*) ! coordinates of points in stroke (WC) X X`09EXTERNAL pc_reqstroke X X`09CALL preqstroke(%VAL(WKID),%VAL(SKDNR),%val(N),STAT,VIEWI, X * NP,PXA,PYA) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC REQUEST VALUATOR XC X`09SUBROUTINE PRQVL (WKID,VLDNR,STAT,VAL) X X`09INTEGER WKID ! workstation identifier X`09INTEGER VLDNR ! valuator device number X`09INTEGER STAT ! status (PNONE,POK) X`09REAL VAL ! value X X`09EXTERNAL pc_reqval X X`09CALL pc_reqval(%VAL(WKID),%VAL(VLDNR),STAT,VAL) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC REQUEST CHOICE XC X`09SUBROUTINE PRQCH (WKID,CHDNR,STAT,CHNR) X X`09INTEGER WKID ! workstation identifier X`09INTEGER CHDNR ! choice device number X`09INTEGER STAT ! status (PNONE,POK,PNCHOI) X`09INTEGER CHNR ! choice number X X`09EXTERNAL pc_reqchoice X X`09CALL pc_reqchoice(%VAL(WKID),%VAL(CHDNR),STAT,CHNR) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC REQUEST PICK XC X`09SUBROUTINE PRQPK (WKID,PKDNR,IPPD,STAT,PPD,PP) X X `09INTEGER WKID ! workstation identifier X `09INTEGER PKDNR ! pick device number X `09INTEGER IPPD ! depth of pick path to return X`09INTEGER STAT ! status (PNONE,POK,PNPICK) X INTEGER PPD ! depth of actual pick path X INTEGER PP (3,*) ! pick path X X`09EXTERNAL pc_reqpick X X`09CALL pc_reqpick(%VAL(WKID),%VAL(PKDNR),%VAL(IPPD),`09 X *`09STAT,PPD, PP) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC SAMPLE LOCATOR 3 XC X`09SUBROUTINE PSMLC3 (WKID,LCDNR,VIEWI,LPX,LPY,LPZ) X X`09INTEGER WKID ! workstation identifier X`09INTEGER LCDNR ! locator device number X`09INTEGER VIEWI ! view index X`09REAL LPX,LPY,LPZ ! locator position (WC) X X`09EXTERNAL pc_sampleloc3 X X`09CALL pc_sampleloc3(%VAL(WKID),%VAL(LCDNR),VIEWI,LPX X * ,LPY,LPZ) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC SAMPLE LOCATOR XC X`09SUBROUTINE PSMLC (WKID,LCDNR,VIEWI,LPX,LPY) X X`09INTEGER WKID ! workstation identifier X`09INTEGER LCDNR ! locator device number X`09INTEGER VIEWI ! view index X`09REAL LPX,LPY ! locator position (WC) X X`09EXTERNAL pc_sampleloc X X`09CALL pc_sampleloc(%VAL(WKID),%VAL(LCDNR),VIEWI,LPX, X * LPY) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC SAMPLE STROKE 3 XC X`09SUBROUTINE PSMSK3 (WKID,SKDNR,N ,VIEWI ,NP,PXA,PYA,PZA) X X`09INTEGER WKID ! workstation identifier `20 X`09INTEGER SKDNR ! stroke device number X`09INTEGER N ! dimension of arrays for strol;e points X`09INTEGER VIEWI ! view index X`09INTEGER NP ! number of points X`09REAL PXA(*), PYA(*), PZA(*) ! coordinates of points in stroke (WC) X X`09EXTERNAL pc_samplestroke3 X X`09CALL pc_samplestroke3(%VAL(WKID),%VAL(SKDNR),%val(N),VIEWI,NP, X * PXA,PYA,PZA) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC SAMPLE STROKE XC X`09SUBROUTINE PSMSK (WKID,SKDNR,N,VIEWI,NP,PXA,PYA) X X INTEGER WKID ! workstation identifier X INTEGER SKDNR ! stroke device number X INTEGER N ! dimension of arrays for stroke points X INTEGER VIEWI ! view index X INTEGER NP ! number of points X REAL PXA(*), PYA(*) ! coordinates of points in stroke (WC) X X`09EXTERNAL pc_samplestroke X X`09CALL pc_samplestroke(%VAL(WKID),%VAL(SKDNR),%val(N),VIEWI,NP X * ,PXA,PYA) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC SAMPLE VALUATOR XC X`09SUBROUTINE PSMVL (WKID,VLDNR,VAL) X X INTEGER WKID ! workstation identifier X INTEGER VLDNR ! valuator device number X REAL VAL ! value X X`09EXTERNAL PSAMPLEVAL X X`09CALL PSAMPLEVAL(%VAL(WKID),%VAL(VLDNR),VAL) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC SAMPLE CHOICE XC X`09SUBROUTINE PSMCH (WKID,CHDNR,STAT,CHNR) X X INTEGER WKID ! workstation identifier X INTEGER CHDNR ! choice device number X INTEGER STAT ! status (POK,PNCHOI) X INTEGER CHNR ! choice number X X`09EXTERNAL pc_samplechoice X X`09CALL pc_samplechoice(%VAL(WKID),%VAL(CHDNR),STAT,CHNR) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC SAMPLE PICK XC +-+-+-+-+-+-+-+- END OF PART 161 +-+-+-+-+-+-+-+-