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