' Veranschaulichungsprogramm zum Dopplereffekt
'
' x-Werte der Kreismittelpunkte, Kreisradien
'
DIM x&(9),r&(9)
'
' Zwei - Bildschirm - Methode
'
zweites_bild$=SPACE$(32256)
orig_bild%=XBIOS(2)
bild1%=orig_bild%
bild2%=INT((VARPTR(zweites_bild$)+255)/256)*256
'
' Hintergrundbild
'
CLIP 0,0 TO 639,399
CLS
DRAW 0,200 TO 639,200
FOR x&=20 TO 639 STEP 20
  DRAW x&,190 TO x&,210
NEXT x&
PRINT AT(10,1);"Erregergeschwindigkeit  =       0.00  *  Phasengeschwindigkeit"
PRINT AT(2,25);"links: (^) <- l   rechts: (^) -> r   mitte: m #   halt: h s     Ende: Esc Undo";
SGET a$
'
' Anfangswerte
'
x&=320
x&(0)=x&
r&(0)=6
zeit&=0
dx&=0                                         ! Schrittweite fr Erreger
'
DO
  '
  IF INP?(2)                                  ! wurde Taste gedrckt ?
    '
    e|=INP(2)                                 ! ja. Byte von Tastatur holen
    '
    ' Halt bei h,H,s,S
    '
    IF e|=104 OR e|=72 OR e|=115 OR e|=83
      e|=INP(2)                               ! warten auf Tastendruck
    ENDIF
    '
    ' links bei l,L,<-
    '
    IF e|=108 OR e|=76 OR e|=203
      dx&=dx&-10
    ENDIF
    '
    ' ganz links bei ^l,^<-
    '
    IF e|=12 OR e|=243
      x&=40
      dx&=0
      ARRAYFILL r&(),0
    ENDIF
    '
    ' rechts bei r,R,->
    '
    IF e|=114 OR e|=82 OR e|=205
      dx&=dx&+10
    ENDIF
    '
    ' ganz rechts bei ^r,^->
    '
    IF e|=18 OR e|=244
      x&=600
      dx&=0
      ARRAYFILL r&(),0
    ENDIF
    '
    ' mitte bei m,M,#
    '
    IF e|=109 OR e|=77 OR e|=35
      x&=320
      dx&=0
      ARRAYFILL r&(),0
    ENDIF
    '
    ' Bild aufheben und Erregergeschwindigkeit in den Hintergrund schreiben
    '
    SGET h$
    SPUT a$
    PRINT AT(40,1);STR$(dx&*0.025,6,2);
    SGET a$
    SPUT h$
    '
    ' Ende bei Esc, Undo
    '
    EXIT IF e|=27 OR e|=225
    '
  ENDIF
  '
  REPEAT                                      ! Nachlaufen verhindern
  UNTIL INKEY$=""
  '
  ' Der Radius eines jeden Kreises wird 10-mal um 2 vergr”žert.
  ' Dann entsteht ein neuer Kreis.
  '
  INC zeit&
  '
  IF zeit&>9
    '
    zeit&=0
    x&=x&+dx&
    '
    IF x&<40
      x&=40
      dx&=0
      SGET h$
      SPUT a$
      PRINT AT(40,1);STR$(dx&*0.025,6,2);
      SGET a$
      SPUT h$
    ENDIF
    '
    IF x&>600
      x&=600
      dx&=0
      SGET h$
      SPUT a$
      PRINT AT(40,1);STR$(dx&*0.025,6,2);
      SGET a$
      SPUT h$
    ENDIF
    '
    PCIRCLE x&,200,4
    INSERT x&(0)=x&
    INSERT r&(0)=6
    '
  ENDIF
  '
  VOID XBIOS(5,L:bild2%,L:bild1%,L:-1)
  SPUT a$
  '
  DEFLINE 1
  FOR n&=0 TO 3
    '
    IF r&(n&)>0
      r&(n&)=r&(n&)+2
      CIRCLE x&(n&),200,r&(n&)
    ENDIF
    '
  NEXT n&
  '
  IF zeit&>8
    DEFLINE 3
  ENDIF
  '
  IF r&(4)>0
    r&(4)=r&(4)+2
    CIRCLE x&(4),200,r&(4)
  ENDIF
  '
  VOID XBIOS(5,L:bild1%,L:bild2%,L:-1)
  SPUT a$
  '
  DEFLINE 1
  FOR n&=0 TO 3
    '
    IF r&(n&)>0
      r&(n&)=r&(n&)+2
      CIRCLE x&(n&),200,r&(n&)
    ENDIF
    '
  NEXT n&
  '
  IF zeit&>8
    DEFLINE 3
  ENDIF
  '
  IF r&(4)>0
    r&(4)=r&(4)+2
    CIRCLE x&(4),200,r&(4)
  ENDIF
  '
LOOP
'
VOID XBIOS(5,L:orig_bild%,L:orig_bild%,L:-1)