RosettaCodeData/Task/Animate-a-pendulum/BASIC/animate-a-pendulum-4.basic

56 lines
1.4 KiB
Plaintext

100 PROGRAM "Pendulum.bas"
110 LET THETA=RAD(50):LET G=9.81:LET L=.5
120 CALL INIC
130 CALL DRAWING
140 CALL ANIMATE
150 CALL RESET
160 END
170 DEF INIC
180 CLOSE #102
190 OPTION ANGLE RADIANS
200 SET STATUS OFF:SET INTERRUPT STOP OFF:SET BORDER 56
210 SET VIDEO MODE 1:SET VIDEO COLOR 1:SET VIDEO X 14:SET VIDEO Y 8
220 FOR I=1 TO 24
230 OPEN #I:"video:"
240 SET #I:PALETTE 56,0,255,YELLOW
250 NEXT
260 END DEF
270 DEF DRAWING
280 LET SPD=0
290 FOR I=1 TO 24
300 DISPLAY #I:AT 3 FROM 1 TO 8
310 SET #I:INK 2
320 PLOT #I:224,280,ELLIPSE 10,10
330 PLOT #I:0,280;214,280,234,280;446,280
340 SET #I:INK 1
350 CALL PENDULUM(THETA,L,I)
360 LET ACC=-G*SIN(THETA)/L/100
370 LET SPD=SPD+ACC/10.5
380 LET THETA=THETA+SPD
390 NEXT
400 END DEF
410 DEF PENDULUM(A,L,CH)
420 LET PX=224:LET PY=280
430 LET BX=PX+L*460*SIN(A)
440 LET BY=PY-L*460*COS(A)
450 PLOT #CH:PX,PY;BX,BY
460 PLOT #CH:BX+24*SIN(A),BY-24*COS(A),ELLIPSE 20,20,
470 SET #CH:INK 3:PLOT #CH:PAINT
480 END DEF
490 DEF ANIMATE
500 DO
510 FOR I=1 TO 24
520 DISPLAY #I:AT 3 FROM 1 TO 8
530 NEXT
540 FOR I=23 TO 2 STEP-1
550 DISPLAY #I:AT 3 FROM 1 TO 8
560 NEXT
570 LOOP UNTIL INKEY$=CHR$(27)
580 END DEF
590 DEF RESET
600 TEXT 40:SET STATUS ON:SET INTERRUPT STOP ON:SET BORDER 0
610 FOR I=24 TO 1 STEP-1
620 CLOSE #I
630 NEXT
640 END DEF