home *** CD-ROM | disk | FTP | other *** search
/ The Very Best of Atari Inside / The Very Best of Atari Inside 1.iso / sharew / elektro / el_demo / doppler.lst next >
Encoding:
File List  |  1989-04-05  |  3.2 KB  |  182 lines
  1. ' Veranschaulichungsprogramm zum Dopplereffekt
  2. '
  3. ' x-Werte der Kreismittelpunkte, Kreisradien
  4. '
  5. DIM x&(9),r&(9)
  6. '
  7. ' Zwei - Bildschirm - Methode
  8. '
  9. zweites_bild$=SPACE$(32256)
  10. orig_bild%=XBIOS(2)
  11. bild1%=orig_bild%
  12. bild2%=INT((VARPTR(zweites_bild$)+255)/256)*256
  13. '
  14. ' Hintergrundbild
  15. '
  16. CLIP 0,0 TO 639,399
  17. CLS
  18. DRAW 0,200 TO 639,200
  19. FOR x&=20 TO 639 STEP 20
  20.   DRAW x&,190 TO x&,210
  21. NEXT x&
  22. PRINT AT(10,1);"Erregergeschwindigkeit  =       0.00  *  Phasengeschwindigkeit"
  23. PRINT AT(2,25);"links: (^) <- l   rechts: (^) -> r   mitte: m #   halt: h s     Ende: Esc Undo";
  24. SGET a$
  25. '
  26. ' Anfangswerte
  27. '
  28. x&=320
  29. x&(0)=x&
  30. r&(0)=6
  31. zeit&=0
  32. dx&=0                                         ! Schrittweite für Erreger
  33. '
  34. DO
  35.   '
  36.   IF INP?(2)                                  ! wurde Taste gedrückt ?
  37.     '
  38.     e|=INP(2)                                 ! ja. Byte von Tastatur holen
  39.     '
  40.     ' Halt bei h,H,s,S
  41.     '
  42.     IF e|=104 OR e|=72 OR e|=115 OR e|=83
  43.       e|=INP(2)                               ! warten auf Tastendruck
  44.     ENDIF
  45.     '
  46.     ' links bei l,L,<-
  47.     '
  48.     IF e|=108 OR e|=76 OR e|=203
  49.       dx&=dx&-10
  50.     ENDIF
  51.     '
  52.     ' ganz links bei ^l,^<-
  53.     '
  54.     IF e|=12 OR e|=243
  55.       x&=40
  56.       dx&=0
  57.       ARRAYFILL r&(),0
  58.     ENDIF
  59.     '
  60.     ' rechts bei r,R,->
  61.     '
  62.     IF e|=114 OR e|=82 OR e|=205
  63.       dx&=dx&+10
  64.     ENDIF
  65.     '
  66.     ' ganz rechts bei ^r,^->
  67.     '
  68.     IF e|=18 OR e|=244
  69.       x&=600
  70.       dx&=0
  71.       ARRAYFILL r&(),0
  72.     ENDIF
  73.     '
  74.     ' mitte bei m,M,#
  75.     '
  76.     IF e|=109 OR e|=77 OR e|=35
  77.       x&=320
  78.       dx&=0
  79.       ARRAYFILL r&(),0
  80.     ENDIF
  81.     '
  82.     ' Bild aufheben und Erregergeschwindigkeit in den Hintergrund schreiben
  83.     '
  84.     SGET h$
  85.     SPUT a$
  86.     PRINT AT(40,1);STR$(dx&*0.025,6,2);
  87.     SGET a$
  88.     SPUT h$
  89.     '
  90.     ' Ende bei Esc, Undo
  91.     '
  92.     EXIT IF e|=27 OR e|=225
  93.     '
  94.   ENDIF
  95.   '
  96.   REPEAT                                      ! Nachlaufen verhindern
  97.   UNTIL INKEY$=""
  98.   '
  99.   ' Der Radius eines jeden Kreises wird 10-mal um 2 vergrößert.
  100.   ' Dann entsteht ein neuer Kreis.
  101.   '
  102.   INC zeit&
  103.   '
  104.   IF zeit&>9
  105.     '
  106.     zeit&=0
  107.     x&=x&+dx&
  108.     '
  109.     IF x&<40
  110.       x&=40
  111.       dx&=0
  112.       SGET h$
  113.       SPUT a$
  114.       PRINT AT(40,1);STR$(dx&*0.025,6,2);
  115.       SGET a$
  116.       SPUT h$
  117.     ENDIF
  118.     '
  119.     IF x&>600
  120.       x&=600
  121.       dx&=0
  122.       SGET h$
  123.       SPUT a$
  124.       PRINT AT(40,1);STR$(dx&*0.025,6,2);
  125.       SGET a$
  126.       SPUT h$
  127.     ENDIF
  128.     '
  129.     PCIRCLE x&,200,4
  130.     INSERT x&(0)=x&
  131.     INSERT r&(0)=6
  132.     '
  133.   ENDIF
  134.   '
  135.   VOID XBIOS(5,L:bild2%,L:bild1%,L:-1)
  136.   SPUT a$
  137.   '
  138.   DEFLINE 1
  139.   FOR n&=0 TO 3
  140.     '
  141.     IF r&(n&)>0
  142.       r&(n&)=r&(n&)+2
  143.       CIRCLE x&(n&),200,r&(n&)
  144.     ENDIF
  145.     '
  146.   NEXT n&
  147.   '
  148.   IF zeit&>8
  149.     DEFLINE 3
  150.   ENDIF
  151.   '
  152.   IF r&(4)>0
  153.     r&(4)=r&(4)+2
  154.     CIRCLE x&(4),200,r&(4)
  155.   ENDIF
  156.   '
  157.   VOID XBIOS(5,L:bild1%,L:bild2%,L:-1)
  158.   SPUT a$
  159.   '
  160.   DEFLINE 1
  161.   FOR n&=0 TO 3
  162.     '
  163.     IF r&(n&)>0
  164.       r&(n&)=r&(n&)+2
  165.       CIRCLE x&(n&),200,r&(n&)
  166.     ENDIF
  167.     '
  168.   NEXT n&
  169.   '
  170.   IF zeit&>8
  171.     DEFLINE 3
  172.   ENDIF
  173.   '
  174.   IF r&(4)>0
  175.     r&(4)=r&(4)+2
  176.     CIRCLE x&(4),200,r&(4)
  177.   ENDIF
  178.   '
  179. LOOP
  180. '
  181. VOID XBIOS(5,L:orig_bild%,L:orig_bild%,L:-1)
  182.