File: PXPA.FT of Tape: Sources/Other/new-14

(Source file text) 

---

C	MAIN PXPA
C
	COMMON JPLOT,JEXTR,JCHRS
	COMMON ICOMM,FNAME,IGREC,IGCHR
	COMMON IDUDS,IDASH,IDSHC,IDSHP
	COMMON X0,Y0,FAKTX,FAKTY,IFONT,DXW,DYW,DXH,DYH
C
	DIMENSION JPLOT(1536),JEXTR(1408),JCHRS(768)
	DIMENSION IDUDS(9,3)
C
	CALL POPEN(IPIC)
	WRITE(1,1100)
1100	FORMAT(' PRINTRONIX POST-PROCESSOR')
	CALL PLOTO
	CALL PLOT(0,0,0)
	RESOL=1024.
C
100	INCHR=IGETC(IPIC)
	IF (IPIC)539,105,1
105	IF (INCHR-53)106,530,106
106	INCHR=IGETC(1)
	GOTO 105
C
1	IF (INCHR-1)100,100,2
2	IF (INCHR-3)20,30,3
3	IF (INCHR-5)40,50,4
4	IF (INCHR-7)60,100,5
5	IF(INCHR-13)999,130,6
6	IF(INCHR-15)999,150,7
7	IF(INCHR-47)160,160,8
8	IF(INCHR-51)480,999,9
9	IF(INCHR-53)520,530,10
10	IF(INCHR-55)540,999,999
C
C	PEN DOWN CODE=2
20	IPEN=3
	IDASH=0
	X=0.
	Y=0.
	GOTO 165
C
C	PEN UP CODE=3
30	IPEN=2
	IDASH=0
	GOTO 100
C
C	SELECT PEN CODE=4
40	INCHR=IGETC(1)
	IF (INCHR-1)41,100,41
41	WRITE(1,1040) INCHR
1040	FORMAT(' NO SELECT PEN ',I3)
	GOTO 100
C
C	ASCII STRING CODE=5
50	N=IGETC(1)
	DO 51 I=1,N
	INCHR=IGETC(1)
51	CALL SYMBOL(INCHR)
	GOTO 100
C
C	CHAR SIZE + ROT CODE=6
60	INCHR=IGETC(1)
	CALL DELTA(DUMMY,DUMM2,INCHR)
	DXW=DUMMY*FAKTX/15.
	DYW=DUMM2*FAKTY/15.
	INCHR=IGETC(1)
	CALL DELTA(DDXH,DDYH,INCHR)
C	WRITE(1,1060) DUMMY,DUMM2,DDXH,DDYH
C1060	FORMAT(' SIZE/ROT = ',4F10.3)
61	IF (IWARP)999,62,63
62	DXH=DDXH*FAKTX/15.
	DYH=DDYH*FAKTY/15.
	GOTO 100
63	DXH=(DDXH+DDYH*.25)*FAKTX/15.
	DYH=(DDYH-DDXH*.25)*FAKTY/15.
	GOTO 100
C
C	DEF.DASH CODE=13
130	J=IGETC(1)
	N=2*IGETC(1)
	DO 131 I=1,N,2
	M=I+1
	INCHR=IGETC(1)
	CALL DELTA(DUMMY,DUMM2,INCHR)
	IDUDS(I,J)=DUMMY*FAKTX
131	IDUDS(M,J)=DUMM2*FAKTX
	IDUDS(I,J)=-1
C	WRITE(1,1130) J,(IDUDS(M,J),M=1,I)
C1130	FORMAT(' DEF.DASH ',I2,' = ',9I6)
	GOTO 100
C
C	END OF PLOT COMMAND CODE=15
150	ICOMM=0
	WRITE(1,1150)
1150	FORMAT(' END OF PLOT '//)
	CALL PLOTC
C
C	DELTA COMMAND CODE=16-47
160	CALL DELTA(X,Y,INCHR)
	IF (IDASH)161,165,161
161	IPEN=3
165	X0=X0+X*FAKTX
	Y0=Y0+Y*FAKTY
	IX=X0
	IY=Y0
	CALL PLOT(IPEN,IX,IY)
C	WRITE(1,1160)IPEN,IX,IY,X,Y
C1160	FORMAT(3I5,2F10.3)
	GOTO 100

C	SELECT DASH CODE=48-50
480	IDASH=INCHR-47
	IF (IDUDS(1,IDASH))481,482,482
481	IDASH=0
	IPEN=2
482	IDSHC=0	
	IDSHP=0
C	WRITE(1,1480) IDASH
C1480	FORMAT(' DASH TYPE = ',I3)
	GOTO 100

C	SELECT CHAR FONT CODE=52
520	INCHR=IGETC(1)
	IF (INCHR-1)527,528,521
521	IF (INCHR-3)528,526,522
522	IF (INCHR-11)527,525,523
523	IF (INCHR-13)525,527,527
C	LOWER ASCII
525	IWARP=INCHR-11
	IFONT=0
	GOTO 61
C	CENTEREDS, NO WARP
526	IWARP=0
	IFONT=1
	GOTO 61
C	NORMAL ASCII
527	WRITE(1,1520) INCHR
1520	FORMAT(' ILLEGAL CHAR. FONT = ',I3)
	INCHR=1
528	IWARP=INCHR-1
529	IFONT=-1
	GOTO 61

C	PICTURE SIZE CODE=53
530	IF (IPIC)537,538,537
538	INCHR=IGETC(1)
539	IPIC=1
	IPEN=2
	IFONT=-1
	IWARP=0
	DXW=0.
	DYW=0.
	DXH=0.
	DYH=0.
	IDASH=0
	IDUDS(1,1)=-1
	IDUDS(1,2)=-1
	IDUDS(1,3)=-1
	X0=0.
	Y0=0.
	DUMMY=1.
	CALL DELTA(WIDTH,HEIGT,INCHR)
	IF (54.2*RESOL-WIDTH)531,531,532
531	DUMMY=54.2*RESOL/WIDTH
532	IF (32.5*RESOL-HEIGT)533,533,535
533	IF (32.5*RESOL/HEIGT-DUMMY)534,535,535
534	DUMMY=32.5*RESOL/HEIGT
535	FAKTX=28.346*DUMMY/RESOL
	FAKTY=23.622*DUMMY/RESOL
	IF (DUMMY-.999)536,536,100
536	WRITE(1,1530) DUMMY
1530	FORMAT(' REDUCTION FACTOR = ',F7.5)
	GOTO 100
C
C	SECOND PICTURE COMING UP
537	ICOMM=-1024
	WRITE(1,1531)
1531	FORMAT(' END OF PICTURE')
	CALL PLOTC
C
C	SPECIAL STRING CODE=54
540	N=IGETC(1)*2
	DO 541 I=1,N
541	INCHR=IGETC(1)
	WRITE(1,1540)
1540	FORMAT(' NO DEVICE DEPENDENT CHARS')
	GOTO 100

C	ERROR
999	WRITE(1,1999) INCHR
1999	FORMAT(' ERROR IN COMMAND = ',I3)
	END

---