-+-+-+-+-+-+-+-+ START OF PART 165 -+-+-+-+-+-+-+-+ X`09SUBROUTINE PSHLFT (WKID, ISN, IS, ESN, ES) X X`09INTEGER WKID X`09INTEGER ISN X`09INTEGER IS (ISN) X`09INTEGER ESN X`09INTEGER ES (ESN) X X`09EXTERNAL pc_sethighlightfilter X X`09CALL pc_sethighlightfilter(%VAL(WKID), %val(ISN), IS,`20 X : %val(ESN), ES) X X`09RETURN X X`09END `20 Xc-------------------------------------------------------------------- `20 X XC XC SET INVISIBILITY FILTER XC X X`09SUBROUTINE PSIVFT (WKID, ISN, IS, ESN, ES) X X`09INTEGER WKID X`09INTEGER ISN X`09INTEGER IS (ISN) X`09INTEGER ESN X`09INTEGER ES (ESN) X X`09EXTERNAL pc_setinvisfilter X X`09CALL pc_setinvisfilter(%VAL(WKID), %val(ISN), IS,`20 X : %val(ESN), ES) X X`09RETURN X X`09END `20 Xc-------------------------------------------------------------------- X `20 XC XC SET COLOUR MODEL XC X X`09SUBROUTINE PSCMD (WKID, CMODEL) X X`09INTEGER WKID X`09INTEGER CMODEL X X`09EXTERNAL PSETCOLOURMODEL X X`09CALL PSETCOLOURMODEL(%VAL(WKID), %VAL(CMODEL)) X X`09RETURN X X`09END `20 Xc-------------------------------------------------------------------- X XC XC SET HLHSR IDENTIFIER XC X X`09SUBROUTINE PSHRID (HRID) X X`09INTEGER HRID`20 X X`09EXTERNAL PSETHLHSRID X X`09CALL PSETHLHSRID(%VAL(HRID))`20 X X`09RETURN X X`09END `20 Xc-------------------------------------------------------------------- `20 X XC XC SET HLHSR MOD XC X X`09SUBROUTINE PSHRM (WKID, HRM) X X`09INTEGER WKID X`09INTEGER HRM`20 X X`09EXTERNAL PSETHLHSRMODE X X`09CALL PSETHLHSRMODE(%VAL(WKID), %VAL(HRM)) X X`09RETURN X X`09END `20 Xc--------------------------------------------------------------------`20 X XC XC`09SET DISPLAY UPDATE STATE XC X`09SUBROUTINE PSDUS (WKID, DEFMOD, MODMOD) X X`09INTEGER WKID X`09INTEGER DEFMOD X`09INTEGER MODMOD X X`09EXTERNAL PSETDISPLAYUPDATEST X X`09CALL PSETDISPLAYUPDATEST(%VAL(WKID),%VAL(DEFMOD),%VAL(MODMOD)) X X`09RETURN X X`09END X Xc-------------------------------------------------------------------- X XC XC SET ERROR HANDLING MODE XC X`09SUBROUTINE PSERHM(ERHM) X X INTEGER ERHM ! error handling mode (POFF, PON) X`09 X`09EXTERNAL PSETERRORHANDMODE X X`09CALL PSETERRORHANDMODE(%VAL(ERHM)) X `20 X`09return X`09end `20 X XC XC SET PICK IDENTIFIER XC X SUBROUTINE PSPKID (PKID) X X INTEGER PKID ! pick identifier X X`09EXTERNAL PSETPICKID X X`09CALL PSETPICKID(%VAL(PKID)) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC SET PICK FILTER XC X SUBROUTINE PSPKFT (WKID, PKDNR, ISN, IS, ESN, ES) X X INTEGER WKID ! workstation identifier X INTEGER PKDNR ! pick device number X INTEGER ISN ! number of names in the inclusion V set X INTEGER IS (*) ! inclusion set X INTEGER ESN ! number of names in the exclusion V set X INTEGER ES (*) ! exclusion set X X`09EXTERNAL pc_setpickfilter X X`09CALL pc_setpickfilter(%VAL(WKID), %VAL(PKDNR), %VAL(ISN), IS, X : %VAL(ESN), ES) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC SET LOCATOR MODE XC X`09 SUBROUTINE PSLCM (WKID,LCDNR,MODE,ESW) X `20 X`09 INTEGER WKID ! workstation identifier X INTEGER LCDNR ! locator device number X INTEGER MODE ! operating mode (PREQU,PSAMPL,PEVENT) X INTEGER ESW ! echo switch (PNECHO,PECHO) X X INTEGER CESW X X`09EXTERNAL PSETLOCMODE X X if (ESW .eq. 0) then X CESW = 1 X else X CESW = 0 X endif X`09CALL PSETLOCMODE(%VAL(WKID),%VAL(LCDNR),%VAL(MODE),%VAL(CESW)) X X`09return X`09end Xc-------------------------------------------------------------------- X XC`20 XC SET STROKE MODE XC`20 X`09SUBROUTINE PSSKM (WKID,SKDNR,MODE,ESW) X X`09INTEGER WKID ! workstation identifier X INTEGER SKDNR ! stroke device number X INTEGER MODE ! operating mode (PREQU,PSAMPL,PEVENT) X INTEGER ESW ! echo switch (PNECHO,PECHO) X X INTEGER CESW X X`09EXTERNAL PSETSTROKEMODE X X if (ESW .eq. 0) then X CESW = 1 X else X CESW = 0 X endif X`09CALL PSETSTROKEMODE(%VAL(WKID),%VAL(SKDNR),%VAL(MODE), X * %VAL(CESW)) X X`09return X`09end Xc-------------------------------------------------------------------- X `20 XC XC SET VALUATOR MODE XC X`09SUBROUTINE PSVLM (WKID,VLDNR,MODE,ESW) X `20 X INTEGER WKID ! workstation identifier X INTEGER VLDNR ! valuator device number X INTEGER MODE ! operating mode (PREQU,PSAMPL,PEVENT) X INTEGER ESW ! echo switch (PNECHO,PECHO) X X INTEGER CESW X X`09EXTERNAL PSETVALMODE X X if (ESW .eq. 0) then X CESW = 1 X else X CESW = 0 X endif X`09CALL PSETVALMODE(%VAL(WKID),%VAL(VLDNR),%VAL(MODE), X : %val(CESW)) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC SET CHOICE MODE XC X`09SUBROUTINE PSCHM (WKID,CHDNR,MODE,ESW) X X `09INTEGER WKID ! workstation identifier X `09INTEGER CHDNR ! choice device number X `09INTEGER MODE ! operating mode (PREQU,PSAMPL,PEVENT) X `09INTEGER ESW ! echo switch (PNECHO,PECHO) X X INTEGER CESW X X`09EXTERNAL PSETCHOICEMODE X X if (ESW .eq. 0) then X CESW = 1 X else X CESW = 0 X endif X`09CALL PSETCHOICEMODE(%VAL(WKID),%VAL(CHDNR),%VAL(MODE), X * %VAL(CESW)) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC SET PICK MODE XC X`09SUBROUTINE PSPKM (WKID,PKDNR,MODE,ESW) X X `09INTEGER WKID ! workstation identifier X `09INTEGER PKDNR ! pick device number X `09INTEGER MODE ! operating mode (PREQU,PSAMPL,PEVENT) X `09INTEGER ESW ! echo switch (PNECHO,PECHO) X X INTEGER CESW X X`09EXTERNAL PSETPICKMODE X X if (ESW .eq. 0) then X CESW = 1 X else X CESW = 0 X endif X`09CALL PSETPICKMODE(%VAL(WKID),%VAL(PKDNR),%VAL(MODE), X * %VAL(CESW)) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC SET STRING MODE XC X`09SUBROUTINE PSSTM (WKID,STDNR,MODE,ESW) X X INTEGER WKID ! workstation identifier X `09INTEGER STDNR ! string device number X `09INTEGER MODE ! operating mode (PREQU,PSAMPL,PEVENT) X `09INTEGER ESW ! echo switch (PNECHO,PECHO) X X INTEGER CESW X X`09EXTERNAL PSETSTRINGMODE X X if (ESW .eq. 0) then X CESW = 1 X else X CESW = 0 X endif X`09CALL PSETSTRINGMODE(%VAL(WKID),%VAL(STDNR),%VAL(MODE), X * %VAL(CESW)) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC SET CONFLICT RESOLUTION XC X`09SUBROUTINE PSCNRS (ARCCR,RETCR) X X`09INTEGER ARCCR X`09INTEGER RETCR ! retrieval conflict resolution (PCRMNT,PCRABA,PCRUPD) X X`09EXTERNAL PSETCONFLICTRES X X`09CALL PSETCONFLICTRES(%VAL(ARCCR),%VAL(RETCR)) X X`09return X`09end Xc-------------------------------------------------------------------- X X XC XC SET EDIT MODE XC X X SUBROUTINE PSEDM (EDITMO) X X `20 X INTEGER EDITMO !edit mode ( PINSRT, PREPLC ) X X`09EXTERNAL PSETEDITMODE X X`09CALL PSETEDITMODE(%VAL(EDITMO)) X X`09return X`09end Xc-------------------------------------------------------------------- X XC`20 XC SET ELEMENT POINTER `20 XC`20 X SUBROUTINE PSEP (EP) X X INTEGER EP ! element position X X`09EXTERNAL PSETELEMPTR X X`09CALL PSETELEMPTR(%VAL(EP)) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC SET ELEMENT POINTER AT LABEL XC`20 X SUBROUTINE PSEPLB (LABEL) X X INTEGER LABEL ! label identifier X X`09EXTERNAL PSETELEMPTRLABEL X X`09CALL PSETELEMPTRLABEL(%VAL(LABEL)) X X`09return X`09end Xc-------------------------------------------------------------------- `20 X XC XC SET LOCAL TRANSFORMATION 3 XC `20 X`09SUBROUTINE PSLMT3 (XFRMT,CTYPE) X X`09REAL XFRMT(4,4) X`09INTEGER CTYPE X`09 X`09EXTERNAL PSETLOCALTRAN3 X X`09CALL PSETLOCALTRAN3(XFRMT, %VAL(CTYPE)) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC SET LOCAL TRANSFORMATION XC X`09SUBROUTINE PSLMT (XFRMT,CTYPE) X X`09REAL XFRMT(3,3) X`09INTEGER CTYPE X X`09EXTERNAL PSETLOCALTRAN X X`09CALL PSETLOCALTRAN(XFRMT, %VAL(CTYPE)) X`09 X`09return X`09end Xc-------------------------------------------------------------------- V `20 XC XC SET GLOBAL TRANSFORMATION 3 XC X `09SUBROUTINE PSGMT3 (XFRMT) X X`09REAL XFRMT(4,4) X X`09EXTERNAL PSETGLOBALTRAN3 X X`09CALL PSETGLOBALTRAN3(XFRMT) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC SET GLOBAL TRANSFORMATION XC X `09SUBROUTINE PSGMT (XFRMT) X X`09REAL XFRMT(3,3) X X`09EXTERNAL PSETGLOBALTRAN X X`09CALL PSETGLOBALTRAN(XFRMT) X X`09return X`09end `20 Xc-------------------------------------------------------------------- X XC XC SET VIEW INDEX XC X`09SUBROUTINE PSVWI (VIEWI) X X`09INTEGER VIEWI X X`09EXTERNAL PSETVIEWIND X X`09CALL PSETVIEWIND(%VAL(VIEWI)) X X`09return X`09end `20 Xc-------------------------------------------------------------------- X XC XC SET VIEW REPRESENTATION 3 XC X`09SUBROUTINE PSVWR3 (WKID,VIEWI,VWORMT,VWMPMT,VWCPLM, X * XYCLPI,BCLIPI,FCLIPI) X X`09INTEGER WKID X`09INTEGER VIEWI`20 X`09REAL VWORMT(4,4) X`09REAL VWMPMT(4,4) X`09REAL VWCPLM(6) X`09INTEGER XYCLPI X`09INTEGER BCLIPI X`09INTEGER FCLIPI X X`09EXTERNAL pc_setviewrep3 X X`09CALL pc_setviewrep3(%VAL(WKID),%VAL(VIEWI),VWORMT,VWMPMT, X * VWCPLM,%val(XYCLPI),%val(BCLIPI),%val(FCLIPI)) X X`09return X`09end `20 Xc-------------------------------------------------------------------- X XC XC SET VIEW REPRESENTATION XC X`09SUBROUTINE PSVWR (WKID,VIEWI,VWORMT,VWMPMT,VWCPLM,XYCLPI) X X`09INTEGER WKID X`09INTEGER VIEWI X`09REAL VWORMT(3,3) X`09REAL VWMPMT(3,3) X`09REAL VWCPLM(4) X`09INTEGER XYCLPI X X`09EXTERNAL pc_setviewrep X X`09CALL pc_setviewrep(%VAL(WKID),%VAL(VIEWI),VWORMT,VWMPMT, X * VWCPLM,%val(XYCLPI)) X X`09return X`09end Xc-------------------------------------------------------------------- X `20 X `20 XC XC SET VIEW TRANSFORMATION INPUT PRIORITY XC X`09SUBROUTINE PSVTIP (WKID, VIEWI, RFVWIX, RELPRI ) X X`09INTEGER WKID X`09INTEGER VIEWI X`09INTEGER RFVWIX X`09INTEGER RELPRI X X`09EXTERNAL PSETVIEWTRANINPUTPRI X X`09CALL PSETVIEWTRANINPUTPRI(%VAL(WKID),%VAL(VIEWI), X * %VAL(RFVWIX),%VAL(RELRPI)) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC SET WORKSTATION WINDOW 3 XC X`09SUBROUTINE PSWKW3 (WKID,WKWN) X `20 X`09INTEGER WKID X`09REAL WKWN(6) X X`09EXTERNAL PSETWSWINDOW3 X X`09CALL PSETWSWINDOW(%VAL(WKID),WKWN) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC SET WORKSTATION WINDOW XC X`09SUBROUTINE PSWKW (WKID,XMIN,XMAX,YMIN,YMAX) X X`09INTEGER WKID X`09REAL XMIN,XMAX,YMIN,YMAX`20 X X`09EXTERNAL pc_setwswindow X X`09CALL pc_setwswindow(%VAL(WKID),XMIN,XMAX,YMIN,YMAX) X X`09return X`09end Xc-------------------------------------------------------------------- `20 X XC XC SET WORKSTATION VIEWPORT 3 XC X`09SUBROUTINE PSWKV3 (WKID,WKVP) X X`09INTEGER WKID `20 X`09REAL WKVP(6) X X`09EXTERNAL PSETWSVIEWPORT3 X X`09CALL PSETWSVIEWPORT3(%VAL(WKID),WKVP) X X`09return X`09end Xc-------------------------------------------------------------------- X XC XC SET WORKSTATION VIEWPORT XC`20 X`09SUBROUTINE PSWKV (WKID,XMIN,XMAX,YMIN,YMAX) X X`09INTEGER WKID `20 X`09REAL XMIN,XMAX,YMIN,YMAX`20 X X`09EXTERNAL pc_setwsviewport X X`09CALL pc_setwsviewport(%VAL(WKID),XMIN,XMAX,YMIN,YMAX) X X`09return X`09end Xc-------------------------------------------------------------------- $ CALL UNPACK [.FORTRAN.SOURCE.BINDING]FSETPHIGS.FOR;1 203070205 $ create 'f' X SUBROUTINE PKPREI ( N, STR ) X* X* (C) COPYRIGHT ICL & SERC 1987 X* X*--------------------------------------------------------------------- X* X* RUTHERFORD / ICL GKS SYSTEM X* X* Type of routine: Utility X* Author: CJC X* X* include '`5B-.include`5DCHECK.INC' X* X* PURPOSE OF THE ROUTINE X* ---------------------- X* Pack on integer into a character string for the data record X* utility GPREC. GKUREI is an inverse. X* X* MAINTENANCE LOG X* --------------- X* 22/01/87 CJC IS conversion. GPREC rewritten to IS specification X* - required a pack utility X* 10/03/87 CJC Stabilisation of new version. X* X* EXTERNAL FUNCTION DEFINITION X* ---------------------------- X`20 X CHARACTER*1 CHAR X`20 X* X* ARGUMENTS X* --------- X* INP N The integer to be packed X* OUT STR The 5 characters to pack N in X INTEGER N X CHARACTER STR(5) X* X* LOCALS X* ------ X* IP Copy of N with sign removed which is manipulated X* IT Intermediate value X* IS sign of N - 0 positive, 8 negative +-+-+-+-+-+-+-+- END OF PART 165 +-+-+-+-+-+-+-+-