| 1 | C ACH JA, DAS AUCH |
| 2 | C |
| 3 | C |
| 4 | INTEGER X,Y |
| 5 | C |
| 6 | C |
| 7 | 1000 CALL PL$RST |
| 8 | C |
| 9 | CALL GITTER |
| 10 | C |
| 11 | CALL PL$MV(0,0) |
| 12 | CALL DOWN |
| 13 | DO 3000 X=0,600 |
| 14 | XR=X |
| 15 | PHI=(3.141/180.0)*XR |
| 16 | Y=SIN(PHI)*90.0 |
| 17 | CALL DODOT(X,Y) |
| 18 | 3000 CONTINUE |
| 19 | CALL UP |
| 20 | C |
| 21 | CALL PL$MV(0,0) |
| 22 | DO 4001 X=0,600 |
| 23 | XR=X |
| 24 | PHI=(3.141/180.0)*XR |
| 25 | Y=COS(PHI)*55.0+SIN(PHI*12.0)*40.0 |
| 26 | CALL DODOT(X,Y) |
| 27 | 4001 CONTINUE |
| 28 | CALL UP |
| 29 | C |
| 30 | C |
| 31 | CALL PL$MV(0,0) |
| 32 | C CALL REBOOT |
| 33 | CALL PL$MV (0,-250) |
| 34 | PAUSE 7 |
| 35 | GO TO 1000 |
| 36 | END |
| 37 | C |
| 38 | C |
| 39 | C |
| 40 | SUBROUTINE DODOT(X,Y) |
| 41 | INTEGER X,Y |
| 42 | IF (Y.LE.100) GO TO 444 |
| 43 | CALL UP |
| 44 | GO TO 3001 |
| 45 | 444 IF (Y.GE.-100) GO TO 555 |
| 46 | CALL UP |
| 47 | GO TO 3001 |
| 48 | 555 CALL PL$MV(X,Y) |
| 49 | CALL DOWN |
| 50 | 3001 RETURN |
| 51 | END |
| 52 | C |
| 53 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC |
| 54 | C |
| 55 | SUBROUTINE GITTER |
| 56 | INTEGER X,Y |
| 57 | DO 2000 X=0,600,50 |
| 58 | CALL LINE(X,-100,X,100) |
| 59 | 2000 CONTINUE |
| 60 | 1500 DO 1600 Y=0,200,50 |
| 61 | CALL LINE(0,Y-100,600,Y-100) |
| 62 | 1600 CONTINUE |
| 63 | 1300 DO 1400 Y=0,150,50 |
| 64 | DO 222 X=0,580,20 |
| 65 | CALL LINE(X,Y-75,X+10,Y-75) |
| 66 | 222 CONTINUE |
| 67 | 1400 CONTINUE |
| 68 | C |
| 69 | CALL LINE (0,1,600,1) |
| 70 | CALL LINE (0,-1,600,-1) |
| 71 | CALL LINE (-1,-100,-1,100) |
| 72 | CALL LINE (1,-100,1,100) |
| 73 | C |
| 74 | RETURN |
| 75 | END |
| 76 | C |
| 77 | C |
| 78 | SUBROUTINE LINE(X1,Y1,X2,Y2) |
| 79 | INTEGER X1,Y1,X2,Y2 |
| 80 | CALL PL$MV(X1,Y1) |
| 81 | CALL PL$PD |
| 82 | CALL PL$MV(X2,Y2) |
| 83 | CALL PL$PU |
| 84 | RETURN |
| 85 | END |
| 86 | CCCCCCCCCC |
| 87 | C |
| 88 | SUBROUTINE DOWN |
| 89 | INTEGER PEN,PENX |
| 90 | COMMON /PENSTA/PEN,PENX |
| 91 | IF (PEN.EQ.0) CALL PL$PD |
| 92 | PEN=1 |
| 93 | PENX=PENX+1 |
| 94 | RETURN |
| 95 | END |
| 96 | C |
| 97 | SUBROUTINE UP |
| 98 | INTEGER PEN,PENX |
| 99 | COMMON /PENSTA/PEN,PENX |
| 100 | IF (PEN.EQ.1) CALL PL$PU |
| 101 | PEN=0 |
| 102 | PENX=PENX+1 |
| 103 | RETURN |
| 104 | END |
| 105 | CCCCCCCCCC |
| 106 | $0 |
| 107 | |
| 108 | |