programs/plotter/src/sinus.f

   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