100 '機械運動学　てこクランク機構 アニメーションプログラム  2005.5.19  T.Oku
150 '---------------------------------------------------------------
200 CLS 3:SCREEN 3
205 SC=0:T=1
210 '--------------------パラメータ
220 X=150:Y=200
225 K=40
230 A=1.5#*K
240 B=4 *K
250 C=4*K
260 D=6*K
280 RAD=3.14159#/180  'ラジアンに変換
290 '計算
300 FOR S=61 TO 420 STEP 1
320 AX=A*COS(S*RAD)
330 AY=A*SIN(S*RAD)
480  AA=(D-A*COS(S*RAD))/(A*SIN(S*RAD))
490  BB=(A^2-B^2+C^2-D^2)/(2*A*SIN(S*RAD))
500    HAN3=(D-AA*BB)^2-(1+AA^2)*(D^2+BB^2-C^2)
510    IF HAN3<0 THEN GOTO 520 ELSE GOTO 530
520  PRINT "計算できません":STOP
530 BX1=(D-AA*BB+SQR(HAN3))/(1+AA^2)
540 BY1=AA*BX1+BB
550 BX2=(D-AA*BB-SQR(HAN3))/(1+AA^2)
560 BY2=AA*BX2+BB
600 IF S=61 THEN 610 ELSE 710
610 BX=BX1:BY=BY1:BXM=BX:BYM=BY
620 GOSUB 800
630 NEXT S
640 GOTO 300
710 B1=SQR((BXM-BX1)^2+(BYM-BY1)^2)
720 B2=SQR((BXM-BX2)^2+(BYM-BY2)^2)
730 IF (B1-B2)<0 THEN 740 ELSE 750
740 BX=BX1:BY=BY1:BXM=BX1:BYM=BY1:GOTO 760
750 BX=BX2:BY=BY2:BXM=BX2:BYM=BY2
760 GOTO 620
770 END
800 'RENDERING--------------------
801 SC=T MOD 2:DP=1+((T+1) MOD 2)*16
802 SCREEN ,,SC,DP
803 CLS 2
810 LINE (X-100,Y)-(X+300,Y),7
820 LINE (X,Y+100)-(X,Y-150),7
830 CIRCLE (X,Y),4
840 CIRCLE (X+AX,Y-AY),4
850 CIRCLE (X+BX,Y-BY),4
860 CIRCLE (X+D,Y),4
870 LINE (X,Y)-(X+AX,Y-AY),7
880 LINE (X+AX,Y-AY)-(X+BX,Y-BY),7
890 LINE (X+BX,Y-BY)-(X+D,Y),7
900 LINE (X,Y)-(X+D,Y),7
910 FOR W=0 TO 300 :NEXT W
920 T=T+1
930 RETURN