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       CALL REBOOT
  33       END
  34 C
  35 C
  36 C
  37       SUBROUTINE DODOT(X,Y)
  38       INTEGER X,Y
  39          IF (Y.LE.100) GO TO 444
  40          CALL UP
  41          GO TO 3001
  42  444     IF (Y.GE.-100) GO TO 555
  43          CALL UP
  44          GO TO 3001
  45  555     CALL PL$MV(X,Y)
  46          CALL DOWN
  47  3001    RETURN
  48          END
  49 C
  50 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  51 C
  52       SUBROUTINE GITTER
  53       INTEGER X,Y
  54       DO 2000 X=0,600,50
  55          CALL LINE(X,-100,X,100)
  56  2000 CONTINUE
  57  1500 DO 1600 Y=0,200,50
  58          CALL LINE(0,Y-100,600,Y-100)
  59  1600 CONTINUE
  60  1300 DO 1400 Y=0,150,50
  61          DO 222 X=0,580,20
  62             CALL LINE(X,Y-75,X+10,Y-75)
  63  222     CONTINUE
  64  1400 CONTINUE
  65 C
  66       CALL LINE (0,1,600,1)
  67       CALL LINE (0,-1,600,-1)
  68       CALL LINE (-1,-100,-1,100)
  69       CALL LINE (1,-100,1,100)
  70 C
  71       RETURN
  72       END
  73 C
  74 C
  75       SUBROUTINE LINE(X1,Y1,X2,Y2)
  76       INTEGER X1,Y1,X2,Y2
  77       CALL PL$MV(X1,Y1)
  78       CALL PL$PD
  79       CALL PL$MV(X2,Y2)
  80       CALL PL$PU
  81       RETURN
  82       END
  83 CCCCCCCCCC
  84 C
  85       SUBROUTINE DOWN
  86       INTEGER PEN,PENX
  87       COMMON /PENSTA/PEN,PENX
  88       IF (PEN.EQ.0) CALL PL$PD
  89       PEN=1
  90       PENX=PENX+1
  91       RETURN
  92       END
  93 C
  94       SUBROUTINE UP
  95       INTEGER PEN,PENX
  96       COMMON /PENSTA/PEN,PENX
  97       IF (PEN.EQ.1) CALL PL$PU
  98       PEN=0
  99       PENX=PENX+1
 100       RETURN
 101       END
 102 CCCCCCCCCC
 103 $0
 104
 105