projects / pdp8.git / blame
| Commit | Line | Data |
|---|---|---|
| 81e70d48 PH |
1 | SUBROUTINE GREEK (X0,Y0,HEIGHT,CHARAC,ANGLE)\r |
| 2 | REAL X0,Y0,HEIGHT,CHARAC,ANGLE\r | |
| 3 | REAL WORD(24),\r | |
| 4 | * X,Y,F,CANGLE,SANGLE\r | |
| 5 | INTEGER GREEK1\r | |
| 6 | EXTERNAL GREEK1\r | |
| 7 | INTEGER I,N1,N2,N3,M1,M2,M3,PENPOS\r | |
| 8 | C\r | |
| 9 | DATA WORD /'THETA','TAU','GAMMA','RHO','ALPHA','BETA','DELTA',\r | |
| 10 | *'EPSILO','ETA','KAPPA','LAMBDA','MY','PHI','PI','ZETA','JOTA',\r | |
| 11 | *'NY','CHI','PSI','OMEGA','XI','SIGMA','OMIKRO','YPSILO'/\r | |
| 12 | C\r | |
| 13 | C\r | |
| 14 | DO 10 I=1,24\r | |
| 15 | CALL CGET(CHARAC,1,N1)\r | |
| 16 | CALL CGET(CHARAC,2,N2)\r | |
| 17 | CALL CGET(CHARAC,3,N3)\r | |
| 18 | CALL CGET(WORD(I),1,M1)\r | |
| 19 | CALL CGET(WORD(I),2,M2)\r | |
| 20 | CALL CGET(WORD(I),3,M3)\r | |
| 21 | IF (N3.EQ.32) M3=32\r | |
| 22 | IF (M1.EQ.N1.AND.M2.EQ.N2.AND.M3.EQ.N3) GOTO 20\r | |
| 23 | 10 CONTINUE\r | |
| 24 | WRITE (0,1) CHARAC\r | |
| 25 | 1 FORMAT (' GREEK DOES NOT KNOW HOW TO PLOT:',A6)\r | |
| 26 | RETURN\r | |
| 27 | C\r | |
| 28 | C\r | |
| 29 | 20 CONTINUE\r | |
| 30 | F=HEIGHT*5.E-2\r | |
| 31 | CANGLE=COS(ANGLE*1.7453293E-2)\r | |
| 32 | SANGLE=SIN(ANGLE*1.7453293E-2)\r | |
| 33 | N1=0\r | |
| 34 | 30 PENPOS=GREEK1(X,Y,I,N1)\r | |
| 35 | IF (PENPOS.LE.0) RETURN\r | |
| 36 | XX=F*X\r | |
| 37 | Y=F*Y\r | |
| 38 | X=XX*CANGLE-Y*SANGLE+X0\r | |
| 39 | Y=XX*SANGLE+Y*CANGLE+Y0\r | |
| 40 | CALL XYPLOT (X,Y,PENPOS)\r | |
| 41 | GOTO 30\r | |
| 42 | END\r | |
| 43 | \1a\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0 |