programs/plotter/src/sinus.f

   1 C ACH JA, DAS AUCH
   2 C
   3 C
   4       INTEGER X,Y
   5 C
   6 C
   7 C
   8  1000 CALL PL$INI
   9       CALL PL$SCL(2.54)
  10 C
  11       CALL GITTER
  12       CALL PL$PU
  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)
  35 C      CALL REBOOT
  36        CALL PL$MV (0,-250)
  37        PAUSE 7
  38        GO TO 1000
  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
  59       INTEGER X,Y,STAK(400)
  60       CALL S$INIT(STAK,400)
  61       DO 2000 X=0,600,50
  62          CALL LINE(X,-100,X,100)
  63  2000 CONTINUE
  64  1500 DO 1600 Y=0,200,50
  65          CALL LINE(0,Y-100,600,Y-100)
  66  1600 CONTINUE
  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
  73       CALL LINE (0,1,600,1)
  74       CALL LINE (0,-1,600,-1)
  75       CALL LINE (-1,-100,-1,100)
  76       CALL LINE (1,-100,1,100)
  77       CALL PL$PU
  78       CALL PL$MV(0,110)
  79       CALL PL$TXT(STAK,37HSinus-Demo, 08.11.2008, Ph. Hachtmann,37)
  80 C
  81       RETURN
  82       END
  83 C
  84 C
  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
  92 CCCCCCCCCC
  93 C
  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
 111 CCCCCCCCCC
 112 $0
 113
 114