FTN,L C C C CC************************************************************ C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * CC************************************************************ C C C C NAME: SETUP C SOURCE: 92840 - 18006 C RELOC: 92840 - 16001 C C C CC*********************************************************** C SUBROUTINE SETUP(P1,P2,P3,P4,P5,P6, 1P7), 92840-16001 REV.2013 791211 C C THIS IS THE AGL FUNCTIONAL FOR THE AGL COMMANDS PLOTR, C FLUSH,GCLR,AND GPON. THE RELATION TO THE STATEMENTS IN THE C PROGRAM AND THESE COMMANDS IS AS FOLLOWS: C STATEMENT COMMAND C 10 PLOTR C 20 GPON C 30 GCLR C C THE STATEMENTS ARE GOTTEN TO BY THE CODE PASSED DOWN IN P1. C INTEGER P0,P4,P5 ,ICMND(5) ,GICB,POINT,ERROR(9) INTEGER P1,P2(2),P3,P6,READ,WRITE,ICODE(6) INTEGER GRIFX INTEGER FLUSH,HOME,DEFLT,PORG,GCLR,ERMSK(2) INTEGER GTPLT,GTCHR,ACTVE,RESET INTEGER SPEND,CLEAR,CSIZE,TRNFR,GTMMU,PTEND EM1901 DIMENSION VAR(17),IBUFR(12) DIMENSION CHR(2) EQUIVALENCE (ICMND,FLUSH),(ICMND(2),DEFLT),(ICMND(3),HOME) EQUIVALENCE (IBUFR(2),IB2),(IBUFR(3),IB3),(IBUFR(4),IB4) EQUIVALENCE (IBUFR(5),IB5),(XLIN,IB5) EQUIVALENCE (CHW,IBUFR(2)),(CHH,IBUFR(4)) EQUIVALENCE (VAR,G1X),(VAR(2),G1Y,BP),(VAR(3),G2X) EQUIVALENCE (VAR(4),G2Y,DP) EQUIVALENCE (AP,VAR),(CP,VAR(3)),(A,VAR(5)),(C,VAR(7)) EQUIVALENCE (VAR(6),V6) EQUIVALENCE (VAR(9),DXGDU),(VAR(10),DYGDU) EQUIVALENCE (VAR(11),PORGX),(VAR(12),PORGY),(VAR(13),PDIRX) EQUIVALENCE (VAR(14),PDIRY) EQUIVALENCE (VAR(15),XMU),(VAR(16),YMU),(VAR(17),XLDIR) EQUIVALENCE (ICODE(2),ICD2),(ICODE(3),ICD3),(ICODE(4),ICD4) EQUIVALENCE (ICODE(5),ICD5),(ICODE(6),ICD6) C C THE FOLLOWING DATA ASSIGNMENTS ARE THE FIRST WORDS IN THE GICB C THE GIC AND LENGTH. C C EM1840 C ERROR IS THE ERROR MASK. THE FIRST WORD ,PRESET TO -1, IS EM1840 C USED TO SPECIFY THE ERROR LOGGING LU. WORDS 2-5 ARE THE EM1840 C ACTUAL ERROR MASK, ASSOCIATED WITH ERRORS AS FOLLOWS: EM1840 C WORD 2 ERRORS 16 - 1 EM1840 C 3 32 - 17 EM1840 C 4 48 - 33 EM1840 C 5 64 - 49 EM81840 C IF THE BIT IS SET, THE ASSOCIATED ERROR IS A HARD ERROR EM1840 C DATA FLUSH/2000B/ DATA GICB/16/ DATA RESET/400B/ DATA DEFLT/1000B/ DATA IHARD/26404B/ DATA CLEAR/1400B/ DATA GCLR/1401B/ DATA HOME/2400B/ DATA GTPLT/4010B/ DATA INIT/22004B/ DATA GTCHR/4404B/ DATA CSIZE/7/ C C SY2013 CHANGED ERROR WORD 2 FROM 135577B TO 125577B C DATA ERROR/-1,125577B,173006B,176B,0/ SY2013 DATA LINE/23/ DATA ACTVE /20000B/ DATA SPEND/40000B/ DATA LFTPN/20400B/ DATA GTMMU/27004B/ DATA ICHW/10404B/ DATA ERMSK/28,27/ DATA READ/1/ DATA WRITE/2/ DATA TRNFR/3/ DATA PORG/14/ C C GIC FOR THE 2608A EM1901 DATA PTEND/3400B/ EM1901 C C IER1 = 0 ISUSP = 0 IERR = 0 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C THIS PORTION OF CODE ADDED 5/12/78 TO CORRECT FOR FAULTY ERROR C MESSAGES REPORTED IN THE IGERR COMMAND WHEN IT IS CALLED AFTER C TWO SUCESSIVE PLOTR CALLS. C THIS CODE CORRECTS THE PROBLEM BY CLEARING OUT A TEMPORARY BUFFER C USED TO TRANSMIT DATA TO AND FROM THE GCB (GRAPHICS CONTROL BLOCK). C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C DO 2 I=1,12 2 IBUFR(I) = 0 C C SELECT AGL COMMAND C P0 = P1 P1 =IABS(P1) GO TO(10,20),P1 C C PLOTR C C C INITIALIZE GCB ADDRESS POINTER C 10 IF(P4.EQ.1.OR.P4.EQ.4)GO TO 110 C C 5 CALL GCBIM(99,1,P2,ISUSP) IF(ISUSP.NE.0)RETURN C C C CHECK ID ,THEN RESET DEVICE (ACTION = 0) C 100 CALL GCBIM(3,1,IBUFR,0,READ) IERR = 1 IF(P3.NE.IBUFR)GO TO 800 CALL OUTPT(3,ICMND,2) C C FOR THE 2608A, SIGNAL THE PLOT IS OVER SO BUFFERS WILL BE CLEARED EM1901 C OUT. THIS GIC NO-OPED BY NON 2608A DEVICES. EM1901 CALL OUTPT(1,PTEND,2) EM1901 C C CLEAR GCB CALL GCBIM(-99,1,P2) DO 109 K=1,128 109 P2(K) = 0 RETURN C C PLOTR IS ACTION = 1 (TURN ON DEVICE) C C C C SET THE LATEST ERROR CODE TO 0 AND ERROR LOGGING LU TO THE EM1840 C CURRENT CONSOLE BEFORE CALLING GCBIM FOR THE FIRST TIME EM1840 C NOTE THAT THIS IS THE ONLY TIME THAT HARDCODED INDICES TO EM1840 C THE GCB SHOULD BE USED. EM1840 C THIS IS THE ONLY PLACE WHERE THE GCB IS ACCESSED DIRECTLY EM1840 110 P2(2) = 0 P2(5) = LOGLU(DUMMY) EM1840 C C FIRST INITIALIZE FWA OF GCB POINTER (P2=GCB) CALL GCBIM(0,1,P2) C C SET WORD 1 OF ERROR TO THE CURRENT CONSOLE AND ENTER WITH EM1840 C ERROR MASK INTO GCB. THIS RESETTING OF LU IS REDUNDANT EM1840 C BUT SAFE EM1840 ERROR(1) = LOGLU(DUMMY) EM1840 CALL GCBIM(ERMSK,2,ERROR,0,WRITE) C C CHECK TO SEE IF THE LU NUMBER IS LEGAL EM1840 CALL PLTER(-97,P5) C C NON POSITIVE ID'S ARE NOT ALLOWED. CHECK HERE FOR THIS INPUT EM1840 C ERROR SO THE NEXT COMMAND WON'T BE CONFUSED WITH A GSWCH(0) EM1913 C CALL FROM SUBROUTINE(OUTPUT). CANNOT CHECK FOR BAD LU EM1840 C MATCH OR TOO LARGE ID AT THIS TIME AS INFO IS NOT EM1840 C AVAILABLE AT THIS LEVEL. EM1840 IF(P3.LE.0)GO TO 799 EM1840 C C CHECK TO SEE IF LU AND ID MATCH EM1840 CALL GSWCH(P3) EM1913 CALL PLTER(-98,ISUSP) IF(ISUSP.NE.0)RETURN C DO 112 K=1,5 112 P2(K) = 0 DO 114 K = 8,192 114 P2(K) = 0 ICODE = 25 IF(P4.EQ.4)P2(8) = 1000B IF(P0.LT.0)IB2 = 8 IBUFR = -99 C C SET BUFFERING BIT C IB3 = P5 IB4 = P3 CALL GCBIM(ICODE,1,IBUFR,0,WRITE) CALL GCBIM(ERMSK,2,ERROR,0,WRITE) C C INVOKE GPON(1) C GO TO 200 C C PLOTR IS ACTION = 2 (RE-ACTIVATE DEVICE) C20 CALL GCBIM(0,1,P2) C CALL PLTER(-98,ISUSP) C IF(ISUSP.EQ.15B.OR.ISUSP.EQ.0)GO TO 123 C RETURN C C CHECK FOR LEGAL ID AND RESET ERROR 13 IF ANY C C23 IERR = 9 C CALL GCBIM(3,1,IBUFR,0,READ) C IF(P3.NE.IBUFR)GO TO 800 C IF(ISUSP.EQ.15B)CALL PLTER(-99,ISUSP) C C GET STATUS FROM GCB AND MAKE SURE THIS IS A PREVIOUSLY C SUSPENDED GCB. C C IERR = 7 C CALL GRSTS(1,40000B,ISTAT) C IF(ISTAT.NE.SPEND)GO TO 800 C C RESET DEVICE TO ACTIVE C C CALL GRSTS(2,17777B,ACTVE) C C RETURN C C PLOTR IS ACTION = 3 (SUSPEND) C C30 IERR = 9 C CALL GCBIM(3,1,IBUFR,0,READ) C IF(P3.NE.IBUFR)GO TO 800 C CALL GRSTS(2,17777B,SPEND) C C RETURN C C GPON(P2), WHERE P2 = LEVEL (1-3) C 20 CALL GCBIM(99,1,P2,ISUSP) IF(ISUSP.NE.0)RETURN IF(P3.LT.1.OR.P3.GT.3)GO TO 830 GO TO(200,210,220),P3 C C GPON LEVEL = 1 C SET DEFAULTS C 200 CALL OUTPT(1,DEFLT,2) C C GPON LEVEL = 2 CLEAR DISPLAY,LIFT PEN AND HOME IT C GET HARD CLIP LIMITS G1 AND G2 AND STORE IN GCB C C 210 CALL OUTPT(1,GTPLT,1) CALL GCBIM(GICB,1,8,1,TRNFR) IBUFR = CLEAR IB2 = LFTPN IB3 = HOME CALL OUTPT(3,IBUFR,2) C C C C C C GPON = LEVEL 3 RESET DEVICE AND COMPUTE TRANSFORMATION C CONSTANTS A' - D' WHERE A' ,C' = MU/GDU AND B',D' = OFFSETS. C C 220 CALL OUTPT(1,RESET,2) CALL GCBIM(8,1,G1X,0,1) DO 230 I= 9,10 230 CALL GCBIM(I,1,G1X,0,2) C C SET HARD CLIP LIMITS IN TO DEVICE C IBUFR = IHARD DO 233 I=2,5 233 IBUFR(I) = GRIFX(VAR(I-1)) CALL OUTPT(1,IBUFR,2) C C GET MU/MM C CALL OUTPT(1,GTMMU,1) CALL GCBIM(GICB,1,XMU,4,1) C C INITIALIZE STATUS WORD C CALL GRSTS(2,3000B,INIT) C C INITIALIZE CHARACTER SIZE INFO, (H,W), LORG AND LDIR(SLANT) C IBUFR = 0 IB2 = 0 IB3 = 0 IB4 = 1 XLIN = 0.0 CALL GCBIM(LINE,1,IBUFR,0,2) C C COMPUTE TRANSFORMATION CONSTANTS C DGX = G2X - G1X DGY = G2Y - G1Y DXMM = DGX/XMU DYMM = DGY/YMU DP = G1Y BP = G1X IF(DXMM.GE.DYMM)GO TO 235 DXGDU = 100.0 DYGDU = 100.0 * (DGY/DGX) GO TO 240 235 DYGDU = 100.0 DXGDU = 100.0* (DGX/DGY) 240 AP = DGX/DXGDU CP = DGY/DYGDU C C ESTABLISH CHARACTER SIZE INFO. C XS = 2.78 * .7 IBUFR = ICHW CHH = CP * 2.78 CHW = AP * XS CALL OUTPT(1,IBUFR,2) CALL GCBIM(7,1,CHW,0,2) CALL OUTPT(1,GTCHR,1) C C SY2013: 33 SETS THE SOFTWARE CHARACTER WIDTH AND HEIGHT(NDC UNITS) C SY2013: 34 INITS THE CHAR SLANT TO 0.0 (GCBIM(34)) C SY2013: GCBIM(35) SETS THE SOFTWARE LDIR TO 0.0 C CHW=2.78*.7 SY2013 CHH=2.78 SY2013 CALL GCBIM(33,1,CHW,0,2) SY2013 CALL GCBIM(GICB,1,7,1,3) SY2013 CALL GCBIM(34,1,0.0,0,2) SY2013 CALL GCBIM(35,1,0.0,0,2) SY2013 C DO 242 I=1,4 242 VAR(I+4) = VAR(I) C C PORGX = 0. PORGY = 0. PDIRX = 1.0 PDIRY = 0. XLDIR = 0. DO 245 I = 1,4 245 ICODE(I) = 10 + I ICD5 = 6 ICD6 = 22 CALL GCBIM(ICODE,6,VAR, 0,WRITE) IF(P4.EQ.4.AND.P1.EQ.1)CALL GRSTS(2,77677B,1000B) RETURN C C C 799 IERR = 2 800 CALL PLTER(IERR,1) RETURN C C 830 CALL PLTER(67) RETURN END END$