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 | |