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       CALL PL$PU
  11 C
  12       CALL PL$MV(0,0)
  13       CALL DOWN
  14       DO 3000 X=0,600
  15          XR=X
  16          PHI=(3.141/180.0)*XR
  17          Y=SIN(PHI)*90.0
  18          CALL DODOT(X,Y)
  19  3000 CONTINUE
  20       CALL UP
  21 C
  22       CALL PL$MV(0,0)
  23       DO 4001 X=0,600
  24          XR=X
  25          PHI=(3.141/180.0)*XR
  26          Y=COS(PHI)*55.0+SIN(PHI*12.0)*40.0
  27          CALL DODOT(X,Y)
  28  4001 CONTINUE
  29       CALL UP
  30 C
  31 C
  32       CALL PL$MV(0,0)
  33 C      CALL REBOOT
  34        CALL PL$MV (0,-250)
  35        PAUSE 7
  36        GO TO 1000
  37       END
  38 C
  39 C
  40 C
  41       SUBROUTINE DODOT(X,Y)
  42       INTEGER X,Y
  43          IF (Y.LE.100) GO TO 444
  44          CALL UP
  45          GO TO 3001
  46  444     IF (Y.GE.-100) GO TO 555
  47          CALL UP
  48          GO TO 3001
  49  555     CALL PL$MV(X,Y)
  50          CALL DOWN
  51  3001    RETURN
  52          END
  53 C
  54 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  55 C
  56       SUBROUTINE GITTER
  57       INTEGER X,Y
  58       DO 2000 X=0,600,50
  59          CALL LINE(X,-100,X,100)
  60  2000 CONTINUE
  61  1500 DO 1600 Y=0,200,50
  62          CALL LINE(0,Y-100,600,Y-100)
  63  1600 CONTINUE
  64  1300 DO 1400 Y=0,150,50
  65          DO 222 X=0,580,20
  66             CALL LINE(X,Y-75,X+10,Y-75)
  67  222     CONTINUE
  68  1400 CONTINUE
  69 C
  70       CALL LINE (0,1,600,1)
  71       CALL LINE (0,-1,600,-1)
  72       CALL LINE (-1,-100,-1,100)
  73       CALL LINE (1,-100,1,100)
  74 C
  75       RETURN
  76       END
  77 C
  78 C
  79 C      SUBROUTINE LINE(X1,Y1,X2,Y2)
  80 C      CALL PL$MV(X1,Y1)
  81 C      CALL PL$PD
  82 C      CALL PL$MV(X2,Y2)
  83 C      CALL PL$PU
  84 C      RETURN
  85 C      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