十進BASIC第2掲示板過去ログ

グラフィックデモ

投稿者：しばっち投稿日：2018年12月15日(土)19時19分21秒

グラフィックデモ。(ラインアニメ) 'S'キーで画像セーブします。png形式で保存します。保存されたコマはお持ちのgifアニメ作成ソフトで変換してください。また、下記のwebサービス等でもgifアニメ作成できます。 https://ezgif.com/ gif,png,webpアニメ作成 https://giphy.com/create/gifmaker gifアニメ作成 http://littlesvr.ca/apng/assembler/assembler.php pngアニメ作成 http://ysklog.net/tool/gif-create.html gifアニメ作成 https://www.bannerkoubou.com/anime/ gifアニメ作成 https://ao-system.net/gifanima/ gifアニメ作成アニメーション対応ビューワ、webブラウザ等(ファイルをブラウザ上にD&Dする)で再生してください http://www.irfanview.com gif,png,webpアニメ対応 http://www.bandisoft.com/honeyview/ gif,png,webp,bpgアニメ対応 gifアニメ投稿サイトでもっと楽しもう https://giphy.com/ OPTION ANGLE DEGREES OPTION BASE 0 CALL GINIT(800,800) LET MODE=0 LET SAVE=0 DO CLEAR LET XMAX=0 LET YMAX=0 LET XMIN=0 LET YMIN=0 SELECT CASE MODE CASE 0 RANDOMIZE LET A1=INT(RND*5)+1 LET B1=INT(RND*10)+1 LET A2=INT(RND*5)+1 LET B2=INT(RND*10)+1 LET R1=INT(RND*5)+1 LET R2=INT(RND*5)+1 LET RR1=INT(RND*5)+1 LET RR2=INT(RND*5)+1 LET NN1=INT(RND*20)+1 LET NN2=INT(RND*20)+1 LET MM1=INT(RND*5)+1 LET MM2=INT(RND*5)+1 PRINT "DATA ";A1;",";A2;",";B1;",";B2;",";MM1;",";MM2;",";R1;",";R2;",";RR1;",";RR2;",";NN1;",";NN2 !'気に入ったものはREAD文の下にコピペしておく CASE 1 READ A1,A2,B1,B2,MM1,MM2,R1,R2,RR1,RR2,NN1,NN2 END SELECT DIM X1(360),X2(360),Y1(360),Y2(360),C(360) FOR I=0 TO 360 LET X1(I)=F(A1,MM1,R1,RR1,NN1,I) LET Y1(I)=G(B1,MM1,R1,RR1,NN1,I) LET X2(I)=F(A2,MM2,R2,RR2,NN2,I) LET Y2(I)=G(B2,MM2,R2,RR2,NN2,I) IF MOD(I,5)=0 AND I<=360-4 THEN LET CC=INT(RND*255+1) FOR J=0 TO 4 LET C(I+J)=CC NEXT J END IF LET XMAX=MAX(XMAX,X1(I)) LET XMAX=MAX(XMAX,X2(I)) LET YMAX=MAX(YMAX,Y1(I)) LET YMAX=MAX(YMAX,Y2(I)) LET XMIN=MIN(XMIN,X1(I)) LET XMIN=MIN(XMIN,X2(I)) LET YMIN=MIN(YMIN,Y1(I)) LET YMIN=MIN(YMIN,Y2(I)) NEXT I SET WINDOW XMIN,XMAX,YMIN,YMAX FOR I=1 TO 360 SET LINE COLOR 1 PLOT LINES: X1(I-1),Y1(I-1);X1(I),Y1(I) SET LINE COLOR 2 PLOT LINES: X2(I-1),Y2(I-1);X2(I),Y2(I) NEXT I LET A$=CONFIRM$("よろしいですか?") LOOP WHILE A$="NO" CLEAR DO IF GETKEYSTATE(ORD("S"))<0 THEN LET SAVE=1 PRINT "セーブ開始" END IF FOR TH=0 TO 359 STEP 2 IF SAVE=0 AND (GETKEYSTATE(32)<0 OR GETKEYSTATE(27)<0) THEN STOP FOR I=TH-15 TO TH SET LINE COLOR C(MOD(I+360,360)) PLOT LINES:X1(MOD(I+360,360)),Y1(MOD(I+360,360));X2(MOD(I+360,360)),Y2(MOD(I+360,360)) NEXT I SET DRAW MODE EXPLICIT WAIT DELAY .05 IF SAVE=1 THEN LET K=K+1 GSAVE "image" & RIGHT$("00000" & STR$(K),5) & ".png" !'gifアニメ用 PRINT "No.";K END IF SET DRAW MODE HIDDEN CLEAR NEXT TH LOOP WHILE SAVE=0 END EXTERNAL FUNCTION F(A,MM,R1,RR1,NN,TH) OPTION ANGLE DEGREES LET F=A*COS(TH*MM)*(R1+RR1*COS(NN*TH)) END FUNCTION EXTERNAL FUNCTION G(A,MM,R1,RR1,NN,TH) OPTION ANGLE DEGREES LET G=A*SIN(TH*MM)*(R1+RR1*SIN(NN*TH)) END FUNCTION EXTERNAL SUB GINIT(XSIZE,YSIZE) SET BITMAP SIZE XSIZE,YSIZE SET WINDOW 0,XSIZE-1,YSIZE-1,0 SET POINT STYLE 1 SET COLOR MODE "REGULAR" FOR I=0 TO 7 SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1) NEXT I CLEAR END SUB

グラフィックデモ

投稿者：しばっち投稿日：2018年12月15日(土)19時20分21秒

グラフイックデモ。(回転アニメ) 'S'キーで画像セーブしますセーブ中はスライドバーを受付しません SET WINDOW -1,1,-1,1 DIM X(10),Y(10),XX(10),YY(10) LOCATE VALUE NOWAIT(1),RANGE 3 TO 10,AT 3:POLYGON LOCATE VALUE NOWAIT(2),RANGE .01 TO .99,AT .1:RATIO LOCATE VALUE NOWAIT(3),RANGE 1 TO 30,AT 6.01:SPEED DO IF SAVE=0 AND (GETKEYSTATE(32)<0 OR GETKEYSTATE(27)<0) THEN STOP IF GETKEYSTATE(ORD("S"))<0 THEN LET SAVE=1 LET TH=0 END IF IF SAVE=0 THEN LOCATE VALUE NOWAIT(1):POLYGON LOCATE VALUE NOWAIT(2):RATIO LOCATE VALUE NOWAIT(3):SPEED END IF LET POLYGON=INT(POLYGON) LET SPEED=INT(SPEED) LET RATIO=ROUND(RATIO,3) LET K=0 LET TH=MOD(TH+SPEED,360) FOR I=0 TO 359 STEP 360/POLYGON LET K=K+1 LET X(K)=SIN(RAD(I-TH))*2 LET Y(K)=COS(RAD(I-TH))*2 NEXT I LET C=0 SET AREA COLOR C MAT PLOT AREA:X,Y DO FOR I=1 TO POLYGON LET XX(I)=(1-RATIO)*X(I)+RATIO*X(MOD(I,POLYGON)+1) LET YY(I)=(1-RATIO)*Y(I)+RATIO*Y(MOD(I,POLYGON)+1) NEXT I LET C=MOD(C+1,2) SET AREA COLOR C MAT PLOT AREA,LIMIT POLYGON:XX,YY MAT X=XX MAT Y=YY LOOP UNTIL SQR((X(2)-X(1))^2+(Y(2)-Y(1))^2)<.03 SET DRAW MODE EXPLICIT WAIT DELAY .1 IF SAVE=1 THEN LET KK=KK+1 GSAVE "image"&USING$("%%%%%",KK)&".png" !'gifアニメ用 PRINT "No.";KK END IF SET DRAW MODE HIDDEN CLEAR LOOP UNTIL SAVE=1 AND TH>=360/POLYGON END

グラフィックデモ

投稿者：しばっち投稿日：2018年12月15日(土)19時21分8秒

グラフイックデモ。(waveアニメ)(円形) 'S'キーで画像セーブします OPTION ANGLE DEGREES SET COLOR MODE "REGULAR" FOR I=0 TO 7 SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1) NEXT I CLEAR LOCATE VALUE NOWAIT(1),RANGE .01 TO 1,AT .1: INTERVAL LOCATE VALUE NOWAIT(2),RANGE .01 TO .5,AT .1 : RADIUS LOCATE VALUE NOWAIT(3),RANGE 1 TO 1000,AT 500 : POWER LOCATE VALUE NOWAIT(4),RANGE .001 TO .1,AT .01: SIZE LOCATE VALUE NOWAIT(5),RANGE 1 TO 30,AT 10 : SPEED LOCATE VALUE NOWAIT(6),RANGE 1 TO 11,AT 1 : MODE LOCATE VALUE NOWAIT(7),RANGE 0 TO 1,AT .4 : COL LOCATE VALUE NOWAIT(8),RANGE -1 TO 0,AT -.5 : XS LOCATE VALUE NOWAIT(9),RANGE -1 TO 0,AT -.5 : YS DO IF SAVE=0 AND GETKEYSTATE(ORD("S"))<0 THEN LET SAVE=1 PRINT "セーブ開始" END IF FOR T=0 TO 359 STEP SPEED IF SAVE=0 THEN LOCATE VALUE NOWAIT(1): INTERVAL LOCATE VALUE NOWAIT(2): RADIUS LOCATE VALUE NOWAIT(3): POWER LOCATE VALUE NOWAIT(4): SIZE LOCATE VALUE NOWAIT(5): SPEED LOCATE VALUE NOWAIT(6): MODE LOCATE VALUE NOWAIT(7): COL LOCATE VALUE NOWAIT(8): XS LOCATE VALUE NOWAIT(9): YS END IF LET MODE=INT(MODE) LET SPEED=INT(SPEED) IF SPEED<>SPE THEN LET SPE=SPEED EXIT FOR END IF SET COLOR MIX(8) COL,COL,COL SET WINDOW XS,XS+1,YS,YS+1 IF COL>0 THEN FOR Y=YS TO YS+1 STEP INTERVAL FOR X=XS TO XS+1 STEP INTERVAL CALL CIRCLE(X,Y,RADIUS,8) NEXT X NEXT Y END IF FOR Y=YS TO YS+1 STEP INTERVAL FOR X=XS TO XS+1 STEP INTERVAL IF GETKEYSTATE(32)<0 AND SAVE=0 THEN STOP SELECT CASE MODE CASE 1 LET L=X+Y CASE 2 LET L=X-Y CASE 3 IF Y=0 THEN LET L=100 ELSE LET L=X/Y CASE 4 LET L=ABS(X)+ABS(Y) CASE 5 LET L=SQR(X*X+Y*Y) CASE 6 LET L=X*Y CASE 7 LET L=MAX(X,Y) CASE 8 LET L=MIN(X,Y) CASE 9 LET L=X^3+Y^3 CASE 10 IF X+Y=0 THEN LET L=100 ELSE LET L=1/(X+Y) CASE 11 IF X=0 AND Y=0 THEN LET L=0 ELSE LET L=ANGLE(X,Y) END SELECT LET L=L*POWER LET XX=X+RADIUS*COS(L+T) LET YY=Y+RADIUS*SIN(L+T) CALL CIRCLEFULL(XX,YY,SIZE,7) NEXT X NEXT Y SET DRAW MODE EXPLICIT WAIT DELAY .05 IF SAVE<>0 THEN LET KK=KK+1 GSAVE "IMAGE"&USING$("%%%%%",KK)&".png" !'gifアニメ用コマ PRINT "No.";KK END IF SET DRAW MODE HIDDEN CLEAR NEXT T LOOP UNTIL SAVE=1 END EXTERNAL SUB CIRCLEFULL(X,Y,RR,C) SET COLOR C DRAW DISK WITH SCALE(RR)*SHIFT(X,Y) END SUB EXTERNAL SUB CIRCLE(X,Y,R,C) SET COLOR C DRAW CIRCLE WITH SCALE(R)*SHIFT(X,Y) END SUB

グラフィックデモ

投稿者：しばっち投稿日：2018年12月15日(土)19時21分38秒

グラフイックデモ。(waveアニメ)(多角形) 'S'キーで画像セーブします OPTION ANGLE DEGREES SET COLOR MODE "REGULAR" FOR I=0 TO 7 SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1) NEXT I CLEAR LOCATE VALUE NOWAIT(1),RANGE .01 TO 1,AT .1: INTERVAL LOCATE VALUE NOWAIT(2),RANGE .01 TO .5,AT .1 : RADIUS LOCATE VALUE NOWAIT(3),RANGE 1 TO 1000,AT 500 : POWER LOCATE VALUE NOWAIT(4),RANGE .001 TO .1,AT .01 : SIZE LOCATE VALUE NOWAIT(5),RANGE 1 TO 30,AT 10 : SPEED LOCATE VALUE NOWAIT(6),RANGE 0 TO 360,AT 0 : ROT LOCATE VALUE NOWAIT(7),RANGE 3 TO 15,AT 3 : POLYGON LOCATE VALUE NOWAIT(8),RANGE 1 TO 11,AT 1 : MODE LOCATE VALUE NOWAIT(9),RANGE 0 TO 1,AT .4 : COL LOCATE VALUE NOWAIT(10),RANGE -1 TO 0,AT -.5 : XS LOCATE VALUE NOWAIT(11),RANGE -1 TO 0,AT -.5 : YS DO IF SAVE=0 AND GETKEYSTATE(ORD("S"))<0 THEN LET SAVE=1 PRINT "セーブ開始" END IF FOR T=0 TO 359 STEP SPEED IF SAVE=0 THEN LOCATE VALUE NOWAIT(1): INTERVAL LOCATE VALUE NOWAIT(2): RADIUS LOCATE VALUE NOWAIT(3): POWER LOCATE VALUE NOWAIT(4): SIZE LOCATE VALUE NOWAIT(5): SPEED LOCATE VALUE NOWAIT(6): ROT LOCATE VALUE NOWAIT(7): POLYGON LOCATE VALUE NOWAIT(8): MODE LOCATE VALUE NOWAIT(9): COL LOCATE VALUE NOWAIT(10): XS LOCATE VALUE NOWAIT(11): YS END IF LET POLYGON=INT(POLYGON) LET ROT=INT(ROT) LET SPEED=INT(SPEED) LET MODE=INT(MODE) LET A=360/POLYGON IF SPEED<>SPE THEN LET SPE=SPEED EXIT FOR END IF SET COLOR MIX(8) COL,COL,COL SET WINDOW XS,XS+1,YS,YS+1 IF COL>0 THEN FOR Y=YS TO YS+1 STEP INTERVAL FOR X=XS TO XS+1 STEP INTERVAL CALL POLY(X,Y,RADIUS,8,-ROT,360-ROT,A) NEXT X NEXT Y END IF FOR Y=YS TO YS+1 STEP INTERVAL FOR X=XS TO XS+1 STEP INTERVAL IF GETKEYSTATE(32)<0 AND SAVE=0 THEN STOP SELECT CASE MODE CASE 1 LET L=X+Y CASE 2 LET L=X-Y CASE 3 IF Y=0 THEN LET L=100 ELSE LET L=X/Y CASE 4 LET L=ABS(X)+ABS(Y) CASE 5 LET L=SQR(X*X+Y*Y) CASE 6 LET L=X*Y CASE 7 LET L=MAX(X,Y) CASE 8 LET L=MIN(X,Y) CASE 9 LET L=X^3+Y^3 CASE 10 IF X+Y=0 THEN LET L=100 ELSE LET L=1/(X+Y) CASE 11 IF X=0 AND Y=0 THEN LET L=0 ELSE LET L=ANGLE(X,Y) END SELECT LET L=L*POWER DO WHILE L<0 LET L=L+360 LOOP LET XX=X+RADIUS*COS(T+ROT+L)*COS(A/2)/COS(A*((T+L)/A-IP((T+L)/A))-A/2) LET YY=Y+RADIUS*SIN(T+ROT+L)*COS(A/2)/COS(A*((T+L)/A-IP((T+L)/A))-A/2) CALL CIRCLEFULL(XX,YY,SIZE,7) NEXT X NEXT Y SET DRAW MODE EXPLICIT WAIT DELAY .05 IF SAVE<>0 THEN LET KK=KK+1 GSAVE "IMAGE"&USING$("%%%%%",KK)&".png" !'gifアニメ用コマ PRINT "No.";KK END IF SET DRAW MODE HIDDEN CLEAR NEXT T LOOP UNTIL SAVE=1 END EXTERNAL SUB CIRCLEFULL(X,Y,RR,C) SET COLOR C DRAW DISK WITH SCALE(RR)*SHIFT(X,Y) END SUB EXTERNAL SUB POLY(X,Y,R,C,S,E,ST) OPTION ANGLE DEGREES SET LINE COLOR C FOR TH=S TO E+ST/2 STEP ST LET X1=X+R*COS(TH) LET Y1=Y-R*SIN(TH) PLOT LINES:X1,Y1; LET X0=X1 LET Y0=Y1 NEXT TH PLOT LINES END SUB

グラフィックデモ

投稿者：しばっち投稿日：2018年12月15日(土)19時22分17秒

グラフイックデモ。(waveアニメ)(星型) 'S'キーで画像セーブします OPTION ANGLE DEGREES SET COLOR MODE "REGULAR" FOR I=0 TO 7 SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1) NEXT I CLEAR LOCATE VALUE NOWAIT(1),RANGE .01 TO 1,AT .1: INTERVAL LOCATE VALUE NOWAIT(2),RANGE .01 TO .5,AT .1 : RADIUS LOCATE VALUE NOWAIT(3),RANGE 1 TO 1000,AT 500 : POWER LOCATE VALUE NOWAIT(4),RANGE .001 TO .1,AT .01 : SIZE LOCATE VALUE NOWAIT(5),RANGE 1 TO 30,AT 10 : SPEED LOCATE VALUE NOWAIT(6),RANGE 0 TO 360,AT 0 : ROT LOCATE VALUE NOWAIT(7),RANGE 5 TO 10,AT 5 : POLYGON LOCATE VALUE NOWAIT(8),RANGE 1 TO 11,AT 1 : MODE LOCATE VALUE NOWAIT(9),RANGE 0 TO 1,AT .4 : COL LOCATE VALUE NOWAIT(10),RANGE -1 TO 0,AT -.5 : XS LOCATE VALUE NOWAIT(11),RANGE -1 TO 0,AT -.5 : YS DO IF SAVE=0 AND GETKEYSTATE(ORD("S"))<0 THEN LET SAVE=1 PRINT "セーブ開始" END IF FOR T=0 TO 359 STEP SPEED IF SAVE=0 THEN LOCATE VALUE NOWAIT(1): INTERVAL LOCATE VALUE NOWAIT(2): RADIUS LOCATE VALUE NOWAIT(3): POWER LOCATE VALUE NOWAIT(4): SIZE LOCATE VALUE NOWAIT(5): SPEED LOCATE VALUE NOWAIT(6): ROT LOCATE VALUE NOWAIT(7): POLYGON LOCATE VALUE NOWAIT(8): MODE LOCATE VALUE NOWAIT(9): COL LOCATE VALUE NOWAIT(10): XS LOCATE VALUE NOWAIT(11): YS END IF LET POLYGON=INT(POLYGON) LET ROT=INT(ROT) LET SPEED=INT(SPEED) LET MODE=INT(MODE) LET A=360/POLYGON IF SPEED<>SPE THEN LET SPE=SPEED EXIT FOR END IF SET COLOR MIX(8) COL,COL,COL SET WINDOW XS,XS+1,YS,YS+1 IF COL>0 THEN FOR Y=YS TO YS+1 STEP INTERVAL FOR X=XS TO XS+1 STEP INTERVAL CALL POLY(X,Y,RADIUS,8,POLYGON,ROT) NEXT X NEXT Y END IF FOR Y=YS TO YS+1 STEP INTERVAL FOR X=XS TO XS+1 STEP INTERVAL IF GETKEYSTATE(32)<0 AND SAVE=0 THEN STOP SELECT CASE MODE CASE 1 LET L=X+Y CASE 2 LET L=X-Y CASE 3 IF Y=0 THEN LET L=100 ELSE LET L=X/Y CASE 4 LET L=ABS(X)+ABS(Y) CASE 5 LET L=SQR(X*X+Y*Y) CASE 6 LET L=X*Y CASE 7 LET L=MAX(X,Y) CASE 8 LET L=MIN(X,Y) CASE 9 LET L=X^3+Y^3 CASE 10 IF X+Y=0 THEN LET L=100 ELSE LET L=1/(X+Y) CASE 11 IF X=0 AND Y=0 THEN LET L=0 ELSE LET L=ANGLE(X,Y) END SELECT LET L=L*POWER LET XX=X+RADIUS*COS(T+ROT+L)*COS(A)/COS(A-1/POLYGON*ACOS(COS(POLYGON*(L+T)))) LET YY=Y+RADIUS*SIN(T+ROT+L)*COS(A)/COS(A-1/POLYGON*ACOS(COS(POLYGON*(L+T)))) CALL CIRCLEFULL(XX,YY,SIZE,7) NEXT X NEXT Y SET DRAW MODE EXPLICIT WAIT DELAY .05 IF SAVE<>0 THEN LET KK=KK+1 GSAVE "IMAGE"&USING$("%%%%%",KK)&".png" !'gifアニメ用コマ PRINT "No.";KK END IF SET DRAW MODE HIDDEN CLEAR NEXT T LOOP UNTIL SAVE=1 END EXTERNAL SUB CIRCLEFULL(X,Y,RR,C) SET COLOR C DRAW DISK WITH SCALE(RR)*SHIFT(X,Y) END SUB EXTERNAL SUB POLY(X,Y,R,C,N,TT) OPTION ANGLE DEGREES SET LINE COLOR C LET A=360/N FOR T=0 TO 360 LET XX=X+R*COS(T+TT)*COS(A)/COS(A-1/N*ACOS(COS(N*T))) LET YY=Y+R*SIN(T+TT)*COS(A)/COS(A-1/N*ACOS(COS(N*T))) PLOT LINES:XX,YY; NEXT T PLOT LINES END SUB

グラフィックデモ

投稿者：しばっち投稿日：2018年12月15日(土)19時23分0秒

グラフイックデモ。(waveアニメ)(リサージュ曲線) 'S'キーで画像セーブします OPTION ANGLE DEGREES SET COLOR MODE "REGULAR" FOR I=0 TO 7 SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1) NEXT I CLEAR LOCATE VALUE NOWAIT(1),RANGE .01 TO 1,AT .1: INTERVAL LOCATE VALUE NOWAIT(2),RANGE .01 TO .5,AT .05 : RADIUS LOCATE VALUE NOWAIT(3),RANGE 1 TO 1000,AT 500 : POWER LOCATE VALUE NOWAIT(4),RANGE .001 TO .1,AT .01 : SIZE LOCATE VALUE NOWAIT(5),RANGE 0 TO 359,AT 0 : ROT LOCATE VALUE NOWAIT(6),RANGE 1 TO 30,AT 10 : SPEED LOCATE VALUE NOWAIT(7),RANGE 1 TO 10,AT 1 : N LOCATE VALUE NOWAIT(8),RANGE 1 TO 10,AT 2 : M LOCATE VALUE NOWAIT(9),RANGE 1 TO 11,AT 1 : MODE LOCATE VALUE NOWAIT(10),RANGE 0 TO 1,AT .4 : COL LOCATE VALUE NOWAIT(11),RANGE -1 TO 0,AT -.5 : XS LOCATE VALUE NOWAIT(12),RANGE -1 TO 0,AT -.5 : YS DO IF SAVE=0 AND GETKEYSTATE(ORD("S"))<0 THEN LET SAVE=1 PRINT "セーブ開始" END IF FOR T=0 TO 359 STEP SPEED IF SAVE=0 THEN LOCATE VALUE NOWAIT(1): INTERVAL LOCATE VALUE NOWAIT(2): RADIUS LOCATE VALUE NOWAIT(3): POWER LOCATE VALUE NOWAIT(4): SIZE LOCATE VALUE NOWAIT(5): ROT LOCATE VALUE NOWAIT(6): SPEED LOCATE VALUE NOWAIT(7): N LOCATE VALUE NOWAIT(8): M LOCATE VALUE NOWAIT(9): MODE LOCATE VALUE NOWAIT(10): COL LOCATE VALUE NOWAIT(11): XS LOCATE VALUE NOWAIT(12): YS END IF LET ROT=INT(ROT) LET SPEED=INT(SPEED) LET N=INT(N) LET M=INT(M) LET MODE=INT(MODE) IF SPEED<>SPE THEN LET SPE=SPEED EXIT FOR END IF SET COLOR MIX(8) COL,COL,COL SET WINDOW XS,XS+1,YS,YS+1 IF COL>0 THEN SET LINE COLOR 8 FOR Y=YS TO YS+1 STEP INTERVAL FOR X=XS TO XS+1 STEP INTERVAL PLOT LINES FOR THETA=0 TO 360 LET XX=X+RADIUS*COS(N*THETA+ROT) LET YY=Y+RADIUS*SIN(M*THETA+ROT) PLOT LINES:XX,YY; NEXT THETA NEXT X NEXT Y END IF FOR Y=YS TO YS+1 STEP INTERVAL FOR X=XS TO XS+1 STEP INTERVAL IF GETKEYSTATE(32)<0 AND SAVE=0 THEN STOP SELECT CASE MODE CASE 1 LET L=X+Y CASE 2 LET L=X-Y CASE 3 IF Y=0 THEN LET L=100 ELSE LET L=X/Y CASE 4 LET L=ABS(X)+ABS(Y) CASE 5 LET L=SQR(X*X+Y*Y) CASE 6 LET L=X*Y CASE 7 LET L=MAX(X,Y) CASE 8 LET L=MIN(X,Y) CASE 9 LET L=X^3+Y^3 CASE 10 IF X+Y=0 THEN LET L=100 ELSE LET L=1/(X+Y) CASE 11 IF X=0 AND Y=0 THEN LET L=0 ELSE LET L=ANGLE(X,Y) END SELECT LET L=L*POWER LET XX=X+RADIUS*COS(N*(T+L)+ROT) LET YY=Y+RADIUS*SIN(M*(T+L)+ROT) CALL CIRCLEFULL(XX,YY,SIZE,7) NEXT X NEXT Y SET DRAW MODE EXPLICIT WAIT DELAY .05 IF SAVE<>0 THEN LET KK=KK+1 GSAVE "IMAGE"&USING$("%%%%%",KK)&".png" !'gifアニメ用コマ PRINT "No.";KK END IF SET DRAW MODE HIDDEN CLEAR NEXT T LOOP UNTIL SAVE=1 END EXTERNAL SUB CIRCLEFULL(X,Y,RR,C) SET COLOR C DRAW DISK WITH SCALE(RR)*SHIFT(X,Y) END SUB

グラフィックデモ

投稿者：しばっち投稿日：2018年12月15日(土)19時23分44秒

グラフイックデモ。(waveアニメ)(バラ曲線) 'S'キーで画像セーブします OPTION ANGLE DEGREES SET COLOR MODE "REGULAR" FOR I=0 TO 7 SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1) NEXT I CLEAR LOCATE VALUE NOWAIT(1),RANGE .01 TO 1,AT .1: INTERVAL LOCATE VALUE NOWAIT(2),RANGE .01 TO .5,AT .1 : RADIUS LOCATE VALUE NOWAIT(3),RANGE .01 TO .5,AT .01 : RADIUS2 LOCATE VALUE NOWAIT(4),RANGE 1 TO 20,AT 5 : CYCLE LOCATE VALUE NOWAIT(5),RANGE 1 TO 1000,AT 500 : POWER LOCATE VALUE NOWAIT(6),RANGE .001 TO .1,AT .01: SIZE LOCATE VALUE NOWAIT(7),RANGE 1 TO 30,AT 10 : SPEED LOCATE VALUE NOWAIT(8),RANGE 0 TO 360,AT 0 : ROT LOCATE VALUE NOWAIT(9),RANGE 1 TO 11,AT 1 : MODE LOCATE VALUE NOWAIT(10),RANGE 0 TO 1,AT .4 : COL LOCATE VALUE NOWAIT(11),RANGE -1 TO 0,AT -.5 : XS LOCATE VALUE NOWAIT(12),RANGE -1 TO 0,AT -.5 : YS DO IF SAVE=0 AND GETKEYSTATE(ORD("S"))<0 THEN LET SAVE=1 PRINT "セーブ開始" END IF FOR T=0 TO 359 STEP SPEED IF SAVE=0 THEN LOCATE VALUE NOWAIT(1): INTERVAL LOCATE VALUE NOWAIT(2): RADIUS LOCATE VALUE NOWAIT(3): RADIUS2 LOCATE VALUE NOWAIT(4): CYCLE LOCATE VALUE NOWAIT(5): POWER LOCATE VALUE NOWAIT(6): SIZE LOCATE VALUE NOWAIT(7): SPEED LOCATE VALUE NOWAIT(8): ROT LOCATE VALUE NOWAIT(9): MODE LOCATE VALUE NOWAIT(10): COL LOCATE VALUE NOWAIT(11): XS LOCATE VALUE NOWAIT(12): YS END IF LET MODE=INT(MODE) LET SPEED=INT(SPEED) LET CYCLE=INT(CYCLE) IF SPEED<>SPE THEN LET SPE=SPEED EXIT FOR END IF SET COLOR MIX(8) COL,COL,COL SET WINDOW XS,XS+1,YS,YS+1 IF COL>0 THEN SET LINE COLOR 8 FOR Y=YS TO YS+1 STEP INTERVAL FOR X=XS TO XS+1 STEP INTERVAL PLOT LINES FOR THETA=0 TO 360 LET XX=X+(RADIUS+RADIUS2*SIN(CYCLE*THETA))*COS(THETA+ROT) LET YY=Y+(RADIUS+RADIUS2*SIN(CYCLE*THETA))*SIN(THETA+ROT) PLOT LINES:XX,YY; NEXT THETA NEXT X NEXT Y END IF FOR Y=YS TO YS+1 STEP INTERVAL FOR X=XS TO XS+1 STEP INTERVAL IF GETKEYSTATE(32)<0 AND SAVE=0 THEN STOP SELECT CASE MODE CASE 1 LET L=X+Y CASE 2 LET L=X-Y CASE 3 IF Y=0 THEN LET L=100 ELSE LET L=X/Y CASE 4 LET L=ABS(X)+ABS(Y) CASE 5 LET L=SQR(X*X+Y*Y) CASE 6 LET L=X*Y CASE 7 LET L=MAX(X,Y) CASE 8 LET L=MIN(X,Y) CASE 9 LET L=X^3+Y^3 CASE 10 IF X+Y=0 THEN LET L=100 ELSE LET L=1/(X+Y) CASE 11 IF X=0 AND Y=0 THEN LET L=0 ELSE LET L=ANGLE(X,Y) END SELECT LET L=L*POWER LET XX=X+(RADIUS+RADIUS2*SIN(CYCLE*(L+T)))*COS(L+T+ROT) LET YY=Y+(RADIUS+RADIUS2*SIN(CYCLE*(L+T)))*SIN(L+T+ROT) CALL CIRCLEFULL(XX,YY,SIZE,7) NEXT X NEXT Y SET DRAW MODE EXPLICIT WAIT DELAY .05 IF SAVE<>0 THEN LET KK=KK+1 GSAVE "IMAGE"&USING$("%%%%%",KK)&".png" !'gifアニメ用コマ PRINT "No.";KK END IF SET DRAW MODE HIDDEN CLEAR NEXT T LOOP UNTIL SAVE=1 END EXTERNAL SUB CIRCLEFULL(X,Y,RR,C) SET COLOR C DRAW DISK WITH SCALE(RR)*SHIFT(X,Y) END SUB

グラフィックデモ

投稿者：しばっち投稿日：2018年12月15日(土)19時25分18秒

グラフイックデモ。(ラインアニメ)(円形) 'S'キーで画像セーブします CALL GINIT(800,800) OPTION ANGLE DEGREES SET WINDOW -1,1,-1,1 LOCATE VALUE NOWAIT(1),RANGE 1 TO 7,AT 2:V LOCATE VALUE NOWAIT(2),RANGE 1 TO 20,AT 3.01:ST LOCATE VALUE NOWAIT(3),RANGE 1 TO 10,AT 2.01:SPEED LOCATE VALUE NOWAIT(4),RANGE 1 TO 20,AT 4:ST2 DO IF GETKEYSTATE(ORD("S"))<0 THEN LET SAVE=1 PRINT "画像セーブ中..." END IF FOR TTT=0 TO 360/INT(ST)-1 STEP SPEED IF SAVE=0 THEN LOCATE VALUE NOWAIT(1):V LOCATE VALUE NOWAIT(2):ST LOCATE VALUE NOWAIT(3):SPEED LOCATE VALUE NOWAIT(4):ST2 IF GETKEYSTATE(32)<0 OR GETKEYSTATE(27)<0 THEN STOP LET V=INT(V) LET ST=INT(ST) LET ST2=INT(ST2) LET SPEED=INT(SPEED) IF SPEED<>SPE THEN LET SPE=SPEED EXIT FOR END IF END IF SET DRAW MODE HIDDEN CLEAR FOR TT=TTT TO TTT+359 STEP 360/ST FOR T=0 TO 359 STEP ST2 CALL LINE(COS(T),SIN(T),COS(TT+V*T),SIN(TT+V*T),7) NEXT T NEXT TT SET DRAW MODE EXPLICIT IF SAVE=1 THEN LET K=K+1 PRINT "image";USING$("%%%%%",K);".png" GSAVE "image" & USING$("%%%%%",K) & ".png" !'gifアニメ用コマ(最大360コマ) END IF WAIT DELAY .05 NEXT TTT LOOP UNTIL SAVE=1 END EXTERNAL SUB GINIT(XSIZE,YSIZE) SET BITMAP SIZE XSIZE,YSIZE !'SET WINDOW 0 , XSIZE-1 , YSIZE-1, 0 SET POINT STYLE 1 FOR I=0 TO 7 SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1) NEXT I CLEAR END SUB EXTERNAL SUB LINE(XS,YS,XE,YE,C) SET LINE COLOR C PLOT LINES:XS,YS;XE,YE END SUB

グラフィックデモ

投稿者：しばっち投稿日：2018年12月15日(土)19時25分59秒

グラフイックデモ。(ラインアニメ)(多角形) 'S'キーで画像セーブしますその場合、パラメーターROTの値によって最初と最後の画像が繋がらない場合があります。 CALL GINIT(800,800) OPTION ANGLE DEGREES SET WINDOW -1,1,-1,1 LOCATE VALUE NOWAIT(1),RANGE 1 TO 7,AT 2:V LOCATE VALUE NOWAIT(2),RANGE 1 TO 20,AT 3.01:ST LOCATE VALUE NOWAIT(3),RANGE 1 TO 10,AT 2.01:SPEED LOCATE VALUE NOWAIT(4),RANGE 1 TO 20,AT 3.01:ST2 LOCATE VALUE NOWAIT(5),RANGE 3 TO 10,AT 3:POLYGON LOCATE VALUE NOWAIT(6),RANGE -1 TO 1,AT .201:ROT LOCATE VALUE NOWAIT(7),RANGE 0 TO 359,AT 0:ROT2 DO IF GETKEYSTATE(ORD("S"))<0 THEN LET SAVE=1 PRINT "画像セーブ中..." END IF FOR TTT=0 TO 360/INT(ST)-1 STEP SPEED IF SAVE=0 THEN LOCATE VALUE NOWAIT(1):V LOCATE VALUE NOWAIT(2):ST LOCATE VALUE NOWAIT(3):SPEED LOCATE VALUE NOWAIT(4):ST2 LOCATE VALUE NOWAIT(5):POLYGON LOCATE VALUE NOWAIT(6):ROT LOCATE VALUE NOWAIT(7):ROT2 IF GETKEYSTATE(32)<0 OR GETKEYSTATE(27)<0 THEN STOP LET V=INT(V) LET ST=INT(ST) LET ST2=INT(ST2) LET SPEED=INT(SPEED) LET ROT2=INT(ROT2) IF SPEED<>SPE THEN LET SPE=SPEED EXIT FOR END IF LET POLYGON=INT(POLYGON) LET ROT=ROUND(ROT,2) LET A=360/POLYGON END IF SET DRAW MODE HIDDEN CLEAR FOR TT=TTT TO TTT+359 STEP 360/ST LET TH=MOD(TH+ROT+360,360) FOR T=0 TO 359 STEP ST2 LET X1=COS(T+TH+ROT2)*COS(A/2)/COS(A*(T/A-IP(T/A))-A/2) LET Y1=SIN(T+TH+ROT2)*COS(A/2)/COS(A*(T/A-IP(T/A))-A/2) LET X2=COS(TT+V*T+TH+ROT2)*COS(A/2)/COS(A*((TT+V*T)/A-IP((TT+V*T)/A))-A/2) LET Y2=SIN(TT+V*T+TH+ROT2)*COS(A/2)/COS(A*((TT+V*T)/A-IP((TT+V*T)/A))-A/2) CALL LINE(X1,Y1,X2,Y2,7) NEXT T NEXT TT SET DRAW MODE EXPLICIT IF SAVE=1 THEN LET K=K+1 PRINT "image";USING$("%%%%%",K);".png" GSAVE "image" & USING$("%%%%%",K) & ".png" !'gifアニメ用コマ END IF WAIT DELAY .05 NEXT TTT LOOP UNTIL SAVE=1 END EXTERNAL SUB GINIT(XSIZE,YSIZE) SET BITMAP SIZE XSIZE,YSIZE !'SET WINDOW 0 , XSIZE-1 , YSIZE-1, 0 SET POINT STYLE 1 FOR I=0 TO 7 SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1) NEXT I CLEAR END SUB EXTERNAL SUB LINE(XS,YS,XE,YE,C) SET LINE COLOR C PLOT LINES:XS,YS;XE,YE END SUB

グラフィックデモ

投稿者：しばっち投稿日：2018年12月15日(土)19時26分38秒

グラフイックデモ。(ラインアニメ)(星型) 'S'キーで画像セーブしますその場合、パラメーターROTの値によって最初と最後の画像が繋がらない場合があります。 CALL GINIT(800,800) OPTION ANGLE DEGREES SET WINDOW -1,1,-1,1 LOCATE VALUE NOWAIT(1),RANGE 1 TO 7,AT 1:V LOCATE VALUE NOWAIT(2),RANGE 1 TO 20,AT 1:ST LOCATE VALUE NOWAIT(3),RANGE 1 TO 10,AT 2.01:SPEED LOCATE VALUE NOWAIT(4),RANGE 1 TO 20,AT 1:ST2 LOCATE VALUE NOWAIT(5),RANGE 5 TO 10,AT 5:POLYGON LOCATE VALUE NOWAIT(6),RANGE -1 TO 1,AT .2:ROT LOCATE VALUE NOWAIT(7),RANGE 0 TO 359,AT 0:ROT2 DO IF GETKEYSTATE(ORD("S"))<0 THEN LET SAVE=1 PRINT "画像セーブ中..." END IF FOR TTT=0 TO 360/INT(ST)-1 STEP SPEED IF SAVE=0 THEN LOCATE VALUE NOWAIT(1):V LOCATE VALUE NOWAIT(2):ST LOCATE VALUE NOWAIT(3):SPEED LOCATE VALUE NOWAIT(4):ST2 LOCATE VALUE NOWAIT(5):POLYGON LOCATE VALUE NOWAIT(6):ROT LOCATE VALUE NOWAIT(7):ROT2 IF GETKEYSTATE(32)<0 OR GETKEYSTATE(27)<0 THEN STOP LET V=INT(V) LET ST=INT(ST) LET ST2=INT(ST2) LET SPEED=INT(SPEED) LET ROT2=INT(ROT2) IF SPEED<>SPE THEN LET SPE=SPEED EXIT FOR END IF LET POLYGON=INT(POLYGON) LET ROT=ROUND(ROT,2) LET A=360/POLYGON END IF SET DRAW MODE HIDDEN CLEAR FOR TT=TTT TO TTT+359 STEP 360/ST LET TH=MOD(TH+ROT+360,360) FOR T=0 TO 359 STEP ST2 LET X1=COS(T+TH+ROT2)*COS(A)/COS(A-1/POLYGON*ACOS(COS(POLYGON*T))) LET Y1=SIN(T+TH+ROT2)*COS(A)/COS(A-1/POLYGON*ACOS(COS(POLYGON*T))) LET X2=COS(TT+V*T+TH+ROT2)*COS(A)/COS(A-1/POLYGON*ACOS(COS(POLYGON*(TT+V*T)))) LET Y2=SIN(TT+V*T+TH+ROT2)*COS(A)/COS(A-1/POLYGON*ACOS(COS(POLYGON*(TT+V*T)))) CALL LINE(X1,Y1,X2,Y2,7) NEXT T NEXT TT SET DRAW MODE EXPLICIT IF SAVE=1 THEN LET K=K+1 PRINT "image";USING$("%%%%%",K);".png" GSAVE "image" & USING$("%%%%%",K) & ".png" !'gifアニメ用コマ END IF WAIT DELAY .05 NEXT TTT LOOP UNTIL SAVE=1 END EXTERNAL SUB GINIT(XSIZE,YSIZE) SET BITMAP SIZE XSIZE,YSIZE !'SET WINDOW 0 , XSIZE-1 , YSIZE-1, 0 SET POINT STYLE 1 FOR I=0 TO 7 SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1) NEXT I CLEAR END SUB EXTERNAL SUB LINE(XS,YS,XE,YE,C) SET LINE COLOR C PLOT LINES:XS,YS;XE,YE END SUB

グラフィックデモ

投稿者：しばっち投稿日：2018年12月15日(土)19時27分17秒

グラフイックデモ。(ラインアニメ)(バラ曲線) 'S'キーで画像セーブしますその場合、パラメーターROTの値によって最初と最後の画像が繋がらない場合があります。 CALL GINIT(800,800) OPTION ANGLE DEGREES SET WINDOW -1,1,-1,1 LOCATE VALUE NOWAIT(1),RANGE 1 TO 7,AT 2:V LOCATE VALUE NOWAIT(2),RANGE 1 TO 20,AT 3.01:ST LOCATE VALUE NOWAIT(3),RANGE 1 TO 10,AT 2.01:SPEED LOCATE VALUE NOWAIT(4),RANGE 1 TO 20,AT 4:ST2 LOCATE VALUE NOWAIT(5),RANGE .1 TO 1,AT .8:R LOCATE VALUE NOWAIT(6),RANGE 0 TO 1,AT .2:R1 LOCATE VALUE NOWAIT(7),RANGE 0 TO 20,AT 3:N LOCATE VALUE NOWAIT(8),RANGE -1 TO 1,AT .2:ROT LOCATE VALUE NOWAIT(9),RANGE 0 TO 359,AT 0:ROT2 DO IF GETKEYSTATE(ORD("S"))<0 THEN LET SAVE=1 PRINT "画像セーブ中..." END IF FOR TTT=0 TO 360/INT(ST)-1 STEP SPEED IF SAVE=0 THEN LOCATE VALUE NOWAIT(1):V LOCATE VALUE NOWAIT(2):ST LOCATE VALUE NOWAIT(3):SPEED LOCATE VALUE NOWAIT(4):ST2 LOCATE VALUE NOWAIT(5):R LOCATE VALUE NOWAIT(6):R1 LOCATE VALUE NOWAIT(7):N LOCATE VALUE NOWAIT(8):ROT LOCATE VALUE NOWAIT(9):ROT2 IF GETKEYSTATE(32)<0 OR GETKEYSTATE(27)<0 THEN STOP LET V=INT(V) LET ST=INT(ST) LET ST2=INT(ST2) LET SPEED=INT(SPEED) LET ROT2=INT(ROT2) IF SPEED<>SPE THEN LET SPE=SPEED EXIT FOR END IF LET N=INT(N) LET ROT=ROUND(ROT,2) END IF SET DRAW MODE HIDDEN CLEAR FOR TT=TTT TO TTT+359 STEP 360/ST LET TH=MOD(TH+ROT+360,360) FOR T=0 TO 359 STEP ST2 LET X1=(R+R1*SIN(N*T+TH+ROT2))*COS(T+TH+ROT2) LET Y1=(R+R1*SIN(N*T+TH+ROT2))*SIN(T+TH+ROT2) LET X2=(R+R1*SIN(N*(TT+V*T)+TH+ROT2))*COS(TT+V*T+TH+ROT2) LET Y2=(R+R1*SIN(N*(TT+V*T)+TH+ROT2))*SIN(TT+V*T+TH+ROT2) CALL LINE(X1,Y1,X2,Y2,7) NEXT T NEXT TT SET DRAW MODE EXPLICIT IF SAVE=1 THEN LET K=K+1 PRINT "image";USING$("%%%%%",K);".png" GSAVE "image" & USING$("%%%%%",K) & ".png" !'gifアニメ用コマ END IF WAIT DELAY .05 NEXT TTT LOOP UNTIL SAVE=1 END EXTERNAL SUB GINIT(XSIZE,YSIZE) SET BITMAP SIZE XSIZE,YSIZE !'SET WINDOW 0 , XSIZE-1 , YSIZE-1, 0 SET POINT STYLE 1 FOR I=0 TO 7 SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1) NEXT I CLEAR END SUB EXTERNAL SUB LINE(XS,YS,XE,YE,C) SET LINE COLOR C PLOT LINES:XS,YS;XE,YE END SUB

グラフィックデモ

投稿者：しばっち投稿日：2018年12月16日(日)10時43分23秒

グラフイックデモ。(トロコイド)(円形) 'S'キーで画像セーブしますスライドバー20本でも足りなくなりました。スペースキーで切り替えてください円周上で円を移動させていますのでトロコイドもどきです。 3個目以降の円は半径 0で消しています。(8個迄) 色を 0(黒)にすると円は見えなくなります。全体の大きさは SCALEです。速さはSPEEDで変化します。 SIGNを0より小さくすると逆回転になります。 CALL GINIT(800,800) OPTION ANGLE DEGREES DIM C(8),T(8),R(8),CL(10),M(8),S(8),L(10) MAT READ C READ CYCLE1,CYCLE2,CYCLE3,CYCLE4,CYCLE5,CYCLE6,CYCLE7,CYCLE8 !'周期初期値 DATA 1,2,3,4,5,6,7,8 DATA 1,2,3,4,5,6,7,8 MAT READ R READ RADIUS1,RADIUS2,RADIUS3,RADIUS4,RADIUS5,RADIUS6,RADIUS7,RADIUS8 !'半径初期値 DATA 1,.5,0,0,0,0,0,0 DATA 1,.5,0,0,0,0,0,0 MAT READ CL READ COL1,COL2,COL3,COL4,COL5,COL6,COL7,COL8,COL9,COL10 !'色初期値 DATA 1,2,3,4,8,9,10,11,5.5,7.5 DATA 1,2,3,4,8,9,10,11,5.5,7.5 MAT READ S READ SIGN1,SIGN2,SIGN3,SIGN4,SIGN5,SIGN6,SIGN7,SIGN8 !'回転向き初期値 DATA 1,1,1,1,1,1,1,1 DATA 1,1,1,1,1,1,1,1 MAT READ L READ WID1,WID2,WID3,WID4,WID5,WID6,WID7,WID8,WID9,WID10 !'ラインの太さ初期値 DATA 1,1,1,1,1,1,1,1,1,1 DATA 1,1,1,1,1,1,1,1,1,1 LET SP=3.01 LET SPEED=SP !'速度初期値 LET SC=4.01 LET SCALE=SC !'ウィンドウ初期値 LET KEY$="CRTKMXW" DO FOR TH=0 TO 359 STEP SPEED IF SAVE=0 THEN IF GETKEYSTATE(ORD("S"))<0 THEN LET SAVE=1 PRINT "セーブ開始" EXIT FOR END IF FOR I=1 TO LEN(KEY$) IF GETKEYSTATE(ORD(KEY$(I:I)))<0 THEN LET PAGE=I-1 LET FLG=0 EXIT FOR END IF NEXT I IF GETKEYSTATE(27)<0 THEN STOP IF GETKEYSTATE(32)<0 THEN DO LOOP WHILE GETKEYSTATE(32)<0 LET PAGE=MOD(PAGE+1,LEN(KEY$)) LET FLG=0 END IF SELECT CASE PAGE CASE 0 !'周期 IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE 0 TO 20,AT C(1):CYCLE1 LOCATE VALUE NOWAIT(2),RANGE 0 TO 20,AT C(2):CYCLE2 LOCATE VALUE NOWAIT(3),RANGE 0 TO 20,AT C(3):CYCLE3 LOCATE VALUE NOWAIT(4),RANGE 0 TO 20,AT C(4):CYCLE4 LOCATE VALUE NOWAIT(5),RANGE 0 TO 20,AT C(5):CYCLE5 LOCATE VALUE NOWAIT(6),RANGE 0 TO 20,AT C(6):CYCLE6 LOCATE VALUE NOWAIT(7),RANGE 0 TO 20,AT C(7):CYCLE7 LOCATE VALUE NOWAIT(8),RANGE 0 TO 20,AT C(8):CYCLE8 LOCATE VALUE NOWAIT(9),RANGE 1 TO 20,AT SP:SPEED LOCATE VALUE NOWAIT(10),RANGE 1 TO 10,AT SC:SCALE LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):CYCLE1 LOCATE VALUE NOWAIT(2):CYCLE2 LOCATE VALUE NOWAIT(3):CYCLE3 LOCATE VALUE NOWAIT(4):CYCLE4 LOCATE VALUE NOWAIT(5):CYCLE5 LOCATE VALUE NOWAIT(6):CYCLE6 LOCATE VALUE NOWAIT(7):CYCLE7 LOCATE VALUE NOWAIT(8):CYCLE8 LOCATE VALUE NOWAIT(9):SPEED LOCATE VALUE NOWAIT(10):SCALE LET C(1)=CYCLE1 LET C(2)=CYCLE2 LET C(3)=CYCLE3 LET C(4)=CYCLE4 LET C(5)=CYCLE5 LET C(6)=CYCLE6 LET C(7)=CYCLE7 LET C(8)=CYCLE8 LET SP=SPEED LET SC=SCALE END IF CASE 1 !'半径 IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE 0 TO 1,AT R(1):RADIUS1 LOCATE VALUE NOWAIT(2),RANGE 0 TO 1,AT R(2):RADIUS2 LOCATE VALUE NOWAIT(3),RANGE 0 TO 1,AT R(3):RADIUS3 LOCATE VALUE NOWAIT(4),RANGE 0 TO 1,AT R(4):RADIUS4 LOCATE VALUE NOWAIT(5),RANGE 0 TO 1,AT R(5):RADIUS5 LOCATE VALUE NOWAIT(6),RANGE 0 TO 1,AT R(6):RADIUS6 LOCATE VALUE NOWAIT(7),RANGE 0 TO 1,AT R(7):RADIUS7 LOCATE VALUE NOWAIT(8),RANGE 0 TO 1,AT R(8):RADIUS8 LOCATE VALUE NOWAIT(9),RANGE 1 TO 20,AT SP:SPEED LOCATE VALUE NOWAIT(10),RANGE 1 TO 10,AT SC:SCALE LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):RADIUS1 LOCATE VALUE NOWAIT(2):RADIUS2 LOCATE VALUE NOWAIT(3):RADIUS3 LOCATE VALUE NOWAIT(4):RADIUS4 LOCATE VALUE NOWAIT(5):RADIUS5 LOCATE VALUE NOWAIT(6):RADIUS6 LOCATE VALUE NOWAIT(7):RADIUS7 LOCATE VALUE NOWAIT(8):RADIUS8 LOCATE VALUE NOWAIT(9):SPEED LOCATE VALUE NOWAIT(10):SCALE LET R(1)=RADIUS1 LET R(2)=RADIUS2 LET R(3)=RADIUS3 LET R(4)=RADIUS4 LET R(5)=RADIUS5 LET R(6)=RADIUS6 LET R(7)=RADIUS7 LET R(8)=RADIUS8 LET SP=SPEED LET SC=SCALE END IF CASE 2 !'開始角度 IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE 0 TO 359,AT T(1):ROT1 LOCATE VALUE NOWAIT(2),RANGE 0 TO 359,AT T(2):ROT2 LOCATE VALUE NOWAIT(3),RANGE 0 TO 359,AT T(3):ROT3 LOCATE VALUE NOWAIT(4),RANGE 0 TO 359,AT T(4):ROT4 LOCATE VALUE NOWAIT(5),RANGE 0 TO 359,AT T(5):ROT5 LOCATE VALUE NOWAIT(6),RANGE 0 TO 359,AT T(6):ROT6 LOCATE VALUE NOWAIT(7),RANGE 0 TO 359,AT T(7):ROT7 LOCATE VALUE NOWAIT(8),RANGE 0 TO 359,AT T(8):ROT8 LOCATE VALUE NOWAIT(9),RANGE 1 TO 20,AT SP:SPEED LOCATE VALUE NOWAIT(10),RANGE 1 TO 10,AT SC:SCALE LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):ROT1 LOCATE VALUE NOWAIT(2):ROT2 LOCATE VALUE NOWAIT(3):ROT3 LOCATE VALUE NOWAIT(4):ROT4 LOCATE VALUE NOWAIT(5):ROT5 LOCATE VALUE NOWAIT(6):ROT6 LOCATE VALUE NOWAIT(7):ROT7 LOCATE VALUE NOWAIT(8):ROT8 LOCATE VALUE NOWAIT(9):SPEED LOCATE VALUE NOWAIT(10):SCALE LET T(1)=ROT1 LET T(2)=ROT2 LET T(3)=ROT3 LET T(4)=ROT4 LET T(5)=ROT5 LET T(6)=ROT6 LET T(7)=ROT7 LET T(8)=ROT8 LET SP=SPEED LET SC=SCALE END IF CASE 3 !'色 IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE 0 TO 255,AT CL(1):COL1 LOCATE VALUE NOWAIT(2),RANGE 0 TO 255,AT CL(2):COL2 LOCATE VALUE NOWAIT(3),RANGE 0 TO 255,AT CL(3):COL3 LOCATE VALUE NOWAIT(4),RANGE 0 TO 255,AT CL(4):COL4 LOCATE VALUE NOWAIT(5),RANGE 0 TO 255,AT CL(5):COL5 LOCATE VALUE NOWAIT(6),RANGE 0 TO 255,AT CL(6):COL6 LOCATE VALUE NOWAIT(7),RANGE 0 TO 255,AT CL(7):COL7 LOCATE VALUE NOWAIT(8),RANGE 0 TO 255,AT CL(8):COL8 LOCATE VALUE NOWAIT(9),RANGE 0 TO 255,AT CL(9):COL9 LOCATE VALUE NOWAIT(10),RANGE 0 TO 255,AT CL(10):COL10 LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):COL1 LOCATE VALUE NOWAIT(2):COL2 LOCATE VALUE NOWAIT(3):COL3 LOCATE VALUE NOWAIT(4):COL4 LOCATE VALUE NOWAIT(5):COL5 LOCATE VALUE NOWAIT(6):COL6 LOCATE VALUE NOWAIT(7):COL7 LOCATE VALUE NOWAIT(8):COL8 LOCATE VALUE NOWAIT(9):COL9 LOCATE VALUE NOWAIT(10):COL10 LET CL(1)=COL1 LET CL(2)=COL2 LET CL(3)=COL3 LET CL(4)=COL4 LET CL(5)=COL5 LET CL(6)=COL6 LET CL(7)=COL7 LET CL(8)=COL8 LET CL(9)=COL9 LET CL(10)=COL10 END IF CASE 4 !'平行移動 IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE -1 TO 1,AT M(1):MOVE1 LOCATE VALUE NOWAIT(2),RANGE -1 TO 1,AT M(2):MOVE2 LOCATE VALUE NOWAIT(3),RANGE -1 TO 1,AT M(3):MOVE3 LOCATE VALUE NOWAIT(4),RANGE -1 TO 1,AT M(4):MOVE4 LOCATE VALUE NOWAIT(5),RANGE -1 TO 1,AT M(5):MOVE5 LOCATE VALUE NOWAIT(6),RANGE -1 TO 1,AT M(6):MOVE6 LOCATE VALUE NOWAIT(7),RANGE -1 TO 1,AT M(7):MOVE7 LOCATE VALUE NOWAIT(8),RANGE -1 TO 1,AT M(8):MOVE8 LOCATE VALUE NOWAIT(9),RANGE 1 TO 20,AT SP:SPEED LOCATE VALUE NOWAIT(10),RANGE 1 TO 10,AT SC:SCALE LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):MOVE1 LOCATE VALUE NOWAIT(2):MOVE2 LOCATE VALUE NOWAIT(3):MOVE3 LOCATE VALUE NOWAIT(4):MOVE4 LOCATE VALUE NOWAIT(5):MOVE5 LOCATE VALUE NOWAIT(6):MOVE6 LOCATE VALUE NOWAIT(7):MOVE7 LOCATE VALUE NOWAIT(8):MOVE8 LOCATE VALUE NOWAIT(9):SPEED LOCATE VALUE NOWAIT(10):SCALE LET M(1)=MOVE1 LET M(2)=MOVE2 LET M(3)=MOVE3 LET M(4)=MOVE4 LET M(5)=MOVE5 LET M(6)=MOVE6 LET M(7)=MOVE7 LET M(8)=MOVE8 LET SP=SPEED LET SC=SCALE END IF CASE 5 !'回転の向き IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE -1 TO 1,AT S(1):SIGN1 LOCATE VALUE NOWAIT(2),RANGE -1 TO 1,AT S(2):SIGN2 LOCATE VALUE NOWAIT(3),RANGE -1 TO 1,AT S(3):SIGN3 LOCATE VALUE NOWAIT(4),RANGE -1 TO 1,AT S(4):SIGN4 LOCATE VALUE NOWAIT(5),RANGE -1 TO 1,AT S(5):SIGN5 LOCATE VALUE NOWAIT(6),RANGE -1 TO 1,AT S(6):SIGN6 LOCATE VALUE NOWAIT(7),RANGE -1 TO 1,AT S(7):SIGN7 LOCATE VALUE NOWAIT(8),RANGE -1 TO 1,AT S(8):SIGN8 LOCATE VALUE NOWAIT(9),RANGE 1 TO 20,AT SP:SPEED LOCATE VALUE NOWAIT(10),RANGE 1 TO 10,AT SC:SCALE LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):SIGN1 LOCATE VALUE NOWAIT(2):SIGN2 LOCATE VALUE NOWAIT(3):SIGN3 LOCATE VALUE NOWAIT(4):SIGN4 LOCATE VALUE NOWAIT(5):SIGN5 LOCATE VALUE NOWAIT(6):SIGN6 LOCATE VALUE NOWAIT(7):SIGN7 LOCATE VALUE NOWAIT(8):SIGN8 LOCATE VALUE NOWAIT(9):SPEED LOCATE VALUE NOWAIT(10):SCALE LET S(1)=SIGN1 LET S(2)=SIGN2 LET S(3)=SIGN3 LET S(4)=SIGN4 LET S(5)=SIGN5 LET S(6)=SIGN6 LET S(7)=SIGN7 LET S(8)=SIGN8 LET SP=SPEED LET SC=SCALE END IF CASE 6 !'ラインの太さ IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE 1 TO 10,AT L(1):WID1 LOCATE VALUE NOWAIT(2),RANGE 1 TO 10,AT L(2):WID2 LOCATE VALUE NOWAIT(3),RANGE 1 TO 10,AT L(3):WID3 LOCATE VALUE NOWAIT(4),RANGE 1 TO 10,AT L(4):WID4 LOCATE VALUE NOWAIT(5),RANGE 1 TO 10,AT L(5):WID5 LOCATE VALUE NOWAIT(6),RANGE 1 TO 10,AT L(6):WID6 LOCATE VALUE NOWAIT(7),RANGE 1 TO 10,AT L(7):WID7 LOCATE VALUE NOWAIT(8),RANGE 1 TO 10,AT L(8):WID8 LOCATE VALUE NOWAIT(9),RANGE 1 TO 10,AT L(9):WID9 LOCATE VALUE NOWAIT(10),RANGE 1 TO 10,AT L(10):WID10 LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):WID1 LOCATE VALUE NOWAIT(2):WID2 LOCATE VALUE NOWAIT(3):WID3 LOCATE VALUE NOWAIT(4):WID4 LOCATE VALUE NOWAIT(5):WID5 LOCATE VALUE NOWAIT(6):WID6 LOCATE VALUE NOWAIT(7):WID7 LOCATE VALUE NOWAIT(8):WID8 LOCATE VALUE NOWAIT(9):WID9 LOCATE VALUE NOWAIT(10):WID10 LET L(1)=WID1 LET L(2)=WID2 LET L(3)=WID3 LET L(4)=WID4 LET L(5)=WID5 LET L(6)=WID6 LET L(7)=WID7 LET L(8)=WID8 LET L(9)=WID9 LET L(10)=WID10 END IF END SELECT END IF SET WINDOW -SCALE,SCALE,-SCALE,SCALE LET CYCLE1=INT(CYCLE1) LET CYCLE2=INT(CYCLE2) LET CYCLE3=INT(CYCLE3) LET CYCLE4=INT(CYCLE4) LET CYCLE5=INT(CYCLE5) LET CYCLE6=INT(CYCLE6) LET CYCLE7=INT(CYCLE7) LET CYCLE8=INT(CYCLE8) LET COL1=INT(COL1) LET COL2=INT(COL2) LET COL3=INT(COL3) LET COL4=INT(COL4) LET COL5=INT(COL5) LET COL6=INT(COL6) LET COL7=INT(COL7) LET COL8=INT(COL8) LET COL9=INT(COL9) LET COL10=INT(COL10) LET WID1=INT(WID1) LET WID2=INT(WID2) LET WID3=INT(WID3) LET WID4=INT(WID4) LET WID5=INT(WID5) LET WID6=INT(WID6) LET WID7=INT(WID7) LET WID8=INT(WID8) LET WID9=INT(WID9) LET WID10=INT(WID10) IF SIGN1>=0 THEN LET SIGN1=1 ELSE LET SIGN1=-1 IF SIGN2>=0 THEN LET SIGN2=1 ELSE LET SIGN2=-1 IF SIGN3>=0 THEN LET SIGN3=1 ELSE LET SIGN3=-1 IF SIGN4>=0 THEN LET SIGN4=1 ELSE LET SIGN4=-1 IF SIGN5>=0 THEN LET SIGN5=1 ELSE LET SIGN5=-1 IF SIGN6>=0 THEN LET SIGN6=1 ELSE LET SIGN6=-1 IF SIGN7>=0 THEN LET SIGN7=1 ELSE LET SIGN7=-1 IF SIGN8>=0 THEN LET SIGN8=1 ELSE LET SIGN8=-1 LET SPEED=INT(SPEED) IF SPEED<>SPE THEN LET SPE=SPEED EXIT FOR END IF CLEAR SET LINE WIDTH 1 DRAW GRID LET X1=0 LET Y1=0 LET X2=FX(RADIUS1+MOVE1,TH*SIGN1,CYCLE1,ROT1) LET Y2=FY(RADIUS1+MOVE1,TH*SIGN1,CYCLE1,ROT1) LET X3=X2+FX(RADIUS2+MOVE2,TH*SIGN2,CYCLE2,ROT2) LET Y3=Y2+FY(RADIUS2+MOVE2,TH*SIGN2,CYCLE2,ROT2) LET X4=X3+FX(RADIUS3+MOVE3,TH*SIGN3,CYCLE3,ROT3) LET Y4=Y3+FY(RADIUS3+MOVE3,TH*SIGN3,CYCLE3,ROT3) LET X5=X4+FX(RADIUS4+MOVE4,TH*SIGN4,CYCLE4,ROT4) LET Y5=Y4+FY(RADIUS4+MOVE4,TH*SIGN4,CYCLE4,ROT4) LET X6=X5+FX(RADIUS5+MOVE5,TH*SIGN5,CYCLE5,ROT5) LET Y6=Y5+FY(RADIUS5+MOVE5,TH*SIGN5,CYCLE5,ROT5) LET X7=X6+FX(RADIUS6+MOVE6,TH*SIGN6,CYCLE6,ROT6) LET Y7=Y6+FY(RADIUS6+MOVE6,TH*SIGN6,CYCLE6,ROT6) LET X8=X7+FX(RADIUS7+MOVE7,TH*SIGN7,CYCLE7,ROT7) LET Y8=Y7+FY(RADIUS7+MOVE7,TH*SIGN7,CYCLE7,ROT7) LET X9=X8+FX(RADIUS8+MOVE8,TH*SIGN8,CYCLE8,ROT8) LET Y9=Y8+FY(RADIUS8+MOVE8,TH*SIGN8,CYCLE8,ROT8) SET LINE WIDTH WID1 CALL CIRCLE(X1,Y1,RADIUS1,COL1) SET LINE WIDTH WID2 CALL CIRCLE(X2,Y2,RADIUS2,COL2) SET LINE WIDTH WID3 CALL CIRCLE(X3,Y3,RADIUS3,COL3) SET LINE WIDTH WID4 CALL CIRCLE(X4,Y4,RADIUS4,COL4) SET LINE WIDTH WID5 CALL CIRCLE(X5,Y5,RADIUS5,COL5) SET LINE WIDTH WID6 CALL CIRCLE(X6,Y6,RADIUS6,COL6) SET LINE WIDTH WID7 CALL CIRCLE(X7,Y7,RADIUS7,COL7) SET LINE WIDTH WID8 CALL CIRCLE(X8,Y8,RADIUS8,COL8) SET LINE WIDTH WID9 SET LINE COLOR COL9 PLOT LINES:X1,Y1;X2,Y2;X3,Y3;X4,Y4;X5,Y5;X6,Y6;X7,Y7;X8,Y8;X9,Y9 SET LINE COLOR COL10 PLOT LINES SET LINE WIDTH WID10 FOR TT=0 TO TH LET X= FX(RADIUS1+MOVE1,TT*SIGN1,CYCLE1,ROT1)+FX(RADIUS2+MOVE2,TT*SIGN2,CYCLE2,ROT2)+FX(RADIUS3+MOVE3,TT*SIGN3,CYCLE3,ROT3)+FX(RADIUS4+MOVE4,TT*SIGN4,CYCLE4,ROT4) LET Y= FY(RADIUS1+MOVE1,TT*SIGN1,CYCLE1,ROT1)+FY(RADIUS2+MOVE2,TT*SIGN2,CYCLE2,ROT2)+FY(RADIUS3+MOVE3,TT*SIGN3,CYCLE3,ROT3)+FY(RADIUS4+MOVE4,TT*SIGN4,CYCLE4,ROT4) LET X=X+FX(RADIUS5+MOVE5,TT*SIGN5,CYCLE5,ROT5)+FX(RADIUS6+MOVE6,TT*SIGN6,CYCLE6,ROT6)+FX(RADIUS7+MOVE7,TT*SIGN7,CYCLE7,ROT7)+FX(RADIUS8+MOVE8,TT*SIGN8,CYCLE8,ROT8) LET Y=Y+FY(RADIUS5+MOVE5,TT*SIGN5,CYCLE5,ROT5)+FY(RADIUS6+MOVE6,TT*SIGN6,CYCLE6,ROT6)+FY(RADIUS7+MOVE7,TT*SIGN7,CYCLE7,ROT1)+FY(RADIUS8+MOVE8,TT*SIGN8,CYCLE8,ROT8) PLOT LINES:X,Y; NEXT TT SET DRAW MODE EXPLICIT IF SAVE=1 THEN LET KK=KK+1 GSAVE "image"&USING$("%%%%%",KK)&".png" PRINT "No.";KK END IF WAIT DELAY .1 SET DRAW MODE HIDDEN NEXT TH LOOP UNTIL SAVE=1 AND TH=>359 END EXTERNAL SUB GINIT(XSIZE,YSIZE) SET BITMAP SIZE XSIZE,YSIZE !'SET WINDOW 0 , XSIZE-1 , YSIZE-1, 0 SET POINT STYLE 1 FOR I=0 TO 7 SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1) NEXT I CLEAR END SUB EXTERNAL SUB CIRCLE(X,Y,R,C) SET COLOR C DRAW CIRCLE WITH SCALE(R)*SHIFT(X,Y) END SUB EXTERNAL FUNCTION FX(R,T,N,ROT) OPTION ANGLE DEGREES LET FX=R*COS(T*N+ROT) END FUNCTION EXTERNAL FUNCTION FY(R,T,N,ROT) OPTION ANGLE DEGREES LET FY=R*SIN(T*N+ROT) END FUNCTION

グラフィックデモ

投稿者：しばっち投稿日：2018年12月16日(日)10時44分12秒

グラフイックデモ。(多角形) トロコイドを多角形で行ってみました。パラメーターPOLYを3未満にすると円になります 'S'キーで画像セーブしますスペースキーで切り替えてください CALL GINIT(800,800) OPTION ANGLE DEGREES DIM C(8),T(8),R(8),P(8),CL(10),M(8),S(8) MAT READ C READ CYCLE1,CYCLE2,CYCLE3,CYCLE4,CYCLE5,CYCLE6,CYCLE7,CYCLE8 DATA 1,2,3,4,5,6,7,8 DATA 1,2,3,4,5,6,7,8 MAT READ R READ RADIUS1,RADIUS2,RADIUS3,RADIUS4,RADIUS5,RADIUS6,RADIUS7,RADIUS8 DATA 1,.5,0,0,0,0,0,0 DATA 1,.5,0,0,0,0,0,0 MAT READ P READ POLY1,POLY2,POLY3,POLY4,POLY5,POLY6,POLY7,POLY8 DATA 3,3,3,3,3,3,3,3 DATA 3,3,3,3,3,3,3,3 MAT READ CL READ COL1,COL2,COL3,COL4,COL5,COL6,COL7,COL8,COL9,COL10 DATA 1,2,3,4,8,9,10,11,5.5,7.5 DATA 1,2,3,4,8,9,10,11,5.5,7.5 LET SP=3.01 LET SPEED=SP LET SC=4.01 LET SCALE=SC LET KEY$="PCRTKMX" DO FOR TH=0 TO 359 STEP SPEED IF SAVE=0 THEN IF GETKEYSTATE(ORD("S"))<0 THEN LET SAVE=1 PRINT "セーブ開始" EXIT FOR END IF FOR I=1 TO LEN(KEY$) IF GETKEYSTATE(ORD(KEY$(I:I)))<0 THEN LET PAGE=I-1 LET FLG=0 EXIT FOR END IF NEXT I IF GETKEYSTATE(27)<0 THEN STOP IF GETKEYSTATE(32)<0 THEN DO LOOP WHILE GETKEYSTATE(32)<0 LET PAGE=MOD(PAGE+1,7) LET FLG=0 END IF SELECT CASE PAGE CASE 0 !'角数 IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE 2 TO 10,AT P(1):POLY1 LOCATE VALUE NOWAIT(2),RANGE 2 TO 10,AT P(2):POLY2 LOCATE VALUE NOWAIT(3),RANGE 2 TO 10,AT P(3):POLY3 LOCATE VALUE NOWAIT(4),RANGE 2 TO 10,AT P(4):POLY4 LOCATE VALUE NOWAIT(5),RANGE 2 TO 10,AT P(5):POLY5 LOCATE VALUE NOWAIT(6),RANGE 2 TO 10,AT P(6):POLY6 LOCATE VALUE NOWAIT(7),RANGE 2 TO 10,AT P(7):POLY7 LOCATE VALUE NOWAIT(8),RANGE 2 TO 10,AT P(8):POLY8 LOCATE VALUE NOWAIT(9),RANGE 1 TO 20,AT SP:SPEED LOCATE VALUE NOWAIT(10),RANGE 1 TO 10,AT SC:SCALE LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):POLY1 LOCATE VALUE NOWAIT(2):POLY2 LOCATE VALUE NOWAIT(3):POLY3 LOCATE VALUE NOWAIT(4):POLY4 LOCATE VALUE NOWAIT(5):POLY5 LOCATE VALUE NOWAIT(6):POLY6 LOCATE VALUE NOWAIT(7):POLY7 LOCATE VALUE NOWAIT(8):POLY8 LOCATE VALUE NOWAIT(9):SPEED LOCATE VALUE NOWAIT(10):SCALE LET P(1)=POLY1 LET P(2)=POLY2 LET P(3)=POLY3 LET P(4)=POLY4 LET P(5)=POLY5 LET P(6)=POLY6 LET P(7)=POLY7 LET P(8)=POLY8 LET SP=SPEED LET SC=SCALE END IF CASE 1 !'周期 IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE 0 TO 20,AT C(1):CYCLE1 LOCATE VALUE NOWAIT(2),RANGE 0 TO 20,AT C(2):CYCLE2 LOCATE VALUE NOWAIT(3),RANGE 0 TO 20,AT C(3):CYCLE3 LOCATE VALUE NOWAIT(4),RANGE 0 TO 20,AT C(4):CYCLE4 LOCATE VALUE NOWAIT(5),RANGE 0 TO 20,AT C(5):CYCLE5 LOCATE VALUE NOWAIT(6),RANGE 0 TO 20,AT C(6):CYCLE6 LOCATE VALUE NOWAIT(7),RANGE 0 TO 20,AT C(7):CYCLE7 LOCATE VALUE NOWAIT(8),RANGE 0 TO 20,AT C(8):CYCLE8 LOCATE VALUE NOWAIT(9),RANGE 1 TO 20,AT SP:SPEED LOCATE VALUE NOWAIT(10),RANGE 1 TO 10,AT SC:SCALE LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):CYCLE1 LOCATE VALUE NOWAIT(2):CYCLE2 LOCATE VALUE NOWAIT(3):CYCLE3 LOCATE VALUE NOWAIT(4):CYCLE4 LOCATE VALUE NOWAIT(5):CYCLE5 LOCATE VALUE NOWAIT(6):CYCLE6 LOCATE VALUE NOWAIT(7):CYCLE7 LOCATE VALUE NOWAIT(8):CYCLE8 LOCATE VALUE NOWAIT(9):SPEED LOCATE VALUE NOWAIT(10):SCALE LET C(1)=CYCLE1 LET C(2)=CYCLE2 LET C(3)=CYCLE3 LET C(4)=CYCLE4 LET C(5)=CYCLE5 LET C(6)=CYCLE6 LET C(7)=CYCLE7 LET C(8)=CYCLE8 LET SP=SPEED LET SC=SCALE END IF CASE 2 !'半径 IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE 0 TO 1,AT R(1):RADIUS1 LOCATE VALUE NOWAIT(2),RANGE 0 TO 1,AT R(2):RADIUS2 LOCATE VALUE NOWAIT(3),RANGE 0 TO 1,AT R(3):RADIUS3 LOCATE VALUE NOWAIT(4),RANGE 0 TO 1,AT R(4):RADIUS4 LOCATE VALUE NOWAIT(5),RANGE 0 TO 1,AT R(5):RADIUS5 LOCATE VALUE NOWAIT(6),RANGE 0 TO 1,AT R(6):RADIUS6 LOCATE VALUE NOWAIT(7),RANGE 0 TO 1,AT R(7):RADIUS7 LOCATE VALUE NOWAIT(8),RANGE 0 TO 1,AT R(8):RADIUS8 LOCATE VALUE NOWAIT(9),RANGE 1 TO 20,AT SP:SPEED LOCATE VALUE NOWAIT(10),RANGE 1 TO 10,AT SC:SCALE LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):RADIUS1 LOCATE VALUE NOWAIT(2):RADIUS2 LOCATE VALUE NOWAIT(3):RADIUS3 LOCATE VALUE NOWAIT(4):RADIUS4 LOCATE VALUE NOWAIT(5):RADIUS5 LOCATE VALUE NOWAIT(6):RADIUS6 LOCATE VALUE NOWAIT(7):RADIUS7 LOCATE VALUE NOWAIT(8):RADIUS8 LOCATE VALUE NOWAIT(9):SPEED LOCATE VALUE NOWAIT(10):SCALE LET R(1)=RADIUS1 LET R(2)=RADIUS2 LET R(3)=RADIUS3 LET R(4)=RADIUS4 LET R(5)=RADIUS5 LET R(6)=RADIUS6 LET R(7)=RADIUS7 LET R(8)=RADIUS8 LET SP=SPEED LET SC=SCALE END IF CASE 3 !'開始角度 IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE 0 TO 359,AT T(1):ROT1 LOCATE VALUE NOWAIT(2),RANGE 0 TO 359,AT T(2):ROT2 LOCATE VALUE NOWAIT(3),RANGE 0 TO 359,AT T(3):ROT3 LOCATE VALUE NOWAIT(4),RANGE 0 TO 359,AT T(4):ROT4 LOCATE VALUE NOWAIT(5),RANGE 0 TO 359,AT T(5):ROT5 LOCATE VALUE NOWAIT(6),RANGE 0 TO 359,AT T(6):ROT6 LOCATE VALUE NOWAIT(7),RANGE 0 TO 359,AT T(7):ROT7 LOCATE VALUE NOWAIT(8),RANGE 0 TO 359,AT T(8):ROT8 LOCATE VALUE NOWAIT(9),RANGE 1 TO 20,AT SP:SPEED LOCATE VALUE NOWAIT(10),RANGE 1 TO 10,AT SC:SCALE LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):ROT1 LOCATE VALUE NOWAIT(2):ROT2 LOCATE VALUE NOWAIT(3):ROT3 LOCATE VALUE NOWAIT(4):ROT4 LOCATE VALUE NOWAIT(5):ROT5 LOCATE VALUE NOWAIT(6):ROT6 LOCATE VALUE NOWAIT(7):ROT7 LOCATE VALUE NOWAIT(8):ROT8 LOCATE VALUE NOWAIT(9):SPEED LOCATE VALUE NOWAIT(10):SCALE LET T(1)=ROT1 LET T(2)=ROT2 LET T(3)=ROT3 LET T(4)=ROT4 LET T(5)=ROT5 LET T(6)=ROT6 LET T(7)=ROT7 LET T(8)=ROT8 LET SP=SPEED LET SC=SCALE END IF CASE 4 !'色 IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE 0 TO 255,AT CL(1):COL1 LOCATE VALUE NOWAIT(2),RANGE 0 TO 255,AT CL(2):COL2 LOCATE VALUE NOWAIT(3),RANGE 0 TO 255,AT CL(3):COL3 LOCATE VALUE NOWAIT(4),RANGE 0 TO 255,AT CL(4):COL4 LOCATE VALUE NOWAIT(5),RANGE 0 TO 255,AT CL(5):COL5 LOCATE VALUE NOWAIT(6),RANGE 0 TO 255,AT CL(6):COL6 LOCATE VALUE NOWAIT(7),RANGE 0 TO 255,AT CL(7):COL7 LOCATE VALUE NOWAIT(8),RANGE 0 TO 255,AT CL(8):COL8 LOCATE VALUE NOWAIT(9),RANGE 0 TO 255,AT CL(9):COL9 LOCATE VALUE NOWAIT(10),RANGE 0 TO 255,AT CL(10):COL10 LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):COL1 LOCATE VALUE NOWAIT(2):COL2 LOCATE VALUE NOWAIT(3):COL3 LOCATE VALUE NOWAIT(4):COL4 LOCATE VALUE NOWAIT(5):COL5 LOCATE VALUE NOWAIT(6):COL6 LOCATE VALUE NOWAIT(7):COL7 LOCATE VALUE NOWAIT(8):COL8 LOCATE VALUE NOWAIT(9):COL9 LOCATE VALUE NOWAIT(10):COL10 LET CL(1)=COL1 LET CL(2)=COL2 LET CL(3)=COL3 LET CL(4)=COL4 LET CL(5)=COL5 LET CL(6)=COL6 LET CL(7)=COL7 LET CL(8)=COL8 LET CL(9)=COL9 LET CL(10)=COL10 END IF CASE 5 !'平行移動 IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE -1 TO 1,AT M(1):MOVE1 LOCATE VALUE NOWAIT(2),RANGE -1 TO 1,AT M(2):MOVE2 LOCATE VALUE NOWAIT(3),RANGE -1 TO 1,AT M(3):MOVE3 LOCATE VALUE NOWAIT(4),RANGE -1 TO 1,AT M(4):MOVE4 LOCATE VALUE NOWAIT(5),RANGE -1 TO 1,AT M(5):MOVE5 LOCATE VALUE NOWAIT(6),RANGE -1 TO 1,AT M(6):MOVE6 LOCATE VALUE NOWAIT(7),RANGE -1 TO 1,AT M(7):MOVE7 LOCATE VALUE NOWAIT(8),RANGE -1 TO 1,AT M(8):MOVE8 LOCATE VALUE NOWAIT(9),RANGE 1 TO 20,AT SP:SPEED LOCATE VALUE NOWAIT(10),RANGE 1 TO 10,AT SC:SCALE LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):MOVE1 LOCATE VALUE NOWAIT(2):MOVE2 LOCATE VALUE NOWAIT(3):MOVE3 LOCATE VALUE NOWAIT(4):MOVE4 LOCATE VALUE NOWAIT(5):MOVE5 LOCATE VALUE NOWAIT(6):MOVE6 LOCATE VALUE NOWAIT(7):MOVE7 LOCATE VALUE NOWAIT(8):MOVE8 LOCATE VALUE NOWAIT(9):SPEED LOCATE VALUE NOWAIT(10):SCALE LET M(1)=MOVE1 LET M(2)=MOVE2 LET M(3)=MOVE3 LET M(4)=MOVE4 LET M(5)=MOVE5 LET M(6)=MOVE6 LET M(7)=MOVE7 LET M(8)=MOVE8 LET SP=SPEED LET SC=SCALE END IF CASE 6 !'回転の向き IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE -1 TO 1,AT S(1):SIGN1 LOCATE VALUE NOWAIT(2),RANGE -1 TO 1,AT S(2):SIGN2 LOCATE VALUE NOWAIT(3),RANGE -1 TO 1,AT S(3):SIGN3 LOCATE VALUE NOWAIT(4),RANGE -1 TO 1,AT S(4):SIGN4 LOCATE VALUE NOWAIT(5),RANGE -1 TO 1,AT S(5):SIGN5 LOCATE VALUE NOWAIT(6),RANGE -1 TO 1,AT S(6):SIGN6 LOCATE VALUE NOWAIT(7),RANGE -1 TO 1,AT S(7):SIGN7 LOCATE VALUE NOWAIT(8),RANGE -1 TO 1,AT S(8):SIGN8 LOCATE VALUE NOWAIT(9),RANGE 1 TO 20,AT SP:SPEED LOCATE VALUE NOWAIT(10),RANGE 1 TO 10,AT SC:SCALE LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):SIGN1 LOCATE VALUE NOWAIT(2):SIGN2 LOCATE VALUE NOWAIT(3):SIGN3 LOCATE VALUE NOWAIT(4):SIGN4 LOCATE VALUE NOWAIT(5):SIGN5 LOCATE VALUE NOWAIT(6):SIGN6 LOCATE VALUE NOWAIT(7):SIGN7 LOCATE VALUE NOWAIT(8):SIGN8 LOCATE VALUE NOWAIT(9):SPEED LOCATE VALUE NOWAIT(10):SCALE LET S(1)=SIGN1 LET S(2)=SIGN2 LET S(3)=SIGN3 LET S(4)=SIGN4 LET S(5)=SIGN5 LET S(6)=SIGN6 LET S(7)=SIGN7 LET S(8)=SIGN8 LET SP=SPEED LET SC=SCALE END IF END SELECT END IF SET WINDOW -SCALE,SCALE,-SCALE,SCALE LET POLY1=INT(POLY1) LET POLY2=INT(POLY2) LET POLY3=INT(POLY3) LET POLY4=INT(POLY4) LET POLY5=INT(POLY5) LET POLY6=INT(POLY6) LET POLY7=INT(POLY7) LET POLY8=INT(POLY8) LET CYCLE1=INT(CYCLE1) LET CYCLE2=INT(CYCLE2) LET CYCLE3=INT(CYCLE3) LET CYCLE4=INT(CYCLE4) LET CYCLE5=INT(CYCLE5) LET CYCLE6=INT(CYCLE6) LET CYCLE7=INT(CYCLE7) LET CYCLE8=INT(CYCLE8) LET COL1=INT(COL1) LET COL2=INT(COL2) LET COL3=INT(COL3) LET COL4=INT(COL4) LET COL5=INT(COL5) LET COL6=INT(COL6) LET COL7=INT(COL7) LET COL8=INT(COL8) LET COL9=INT(COL9) LET COL10=INT(COL10) IF SIGN1>=0 THEN LET SIGN1=1 ELSE LET SIGN1=-1 IF SIGN2>=0 THEN LET SIGN2=1 ELSE LET SIGN2=-1 IF SIGN3>=0 THEN LET SIGN3=1 ELSE LET SIGN3=-1 IF SIGN4>=0 THEN LET SIGN4=1 ELSE LET SIGN4=-1 IF SIGN5>=0 THEN LET SIGN5=1 ELSE LET SIGN5=-1 IF SIGN6>=0 THEN LET SIGN6=1 ELSE LET SIGN6=-1 IF SIGN7>=0 THEN LET SIGN7=1 ELSE LET SIGN7=-1 IF SIGN8>=0 THEN LET SIGN8=1 ELSE LET SIGN8=-1 LET SPEED=INT(SPEED) IF SPEED<>SPE THEN LET SPE=SPEED EXIT FOR END IF CLEAR DRAW GRID LET X1=0 LET Y1=0 LET X2=FX(POLY1,CYCLE1,RADIUS1+MOVE1,TH*SIGN1,ROT1) LET Y2=FY(POLY1,CYCLE1,RADIUS1+MOVE1,TH*SIGN1,ROT1) LET X3=X2+FX(POLY2,CYCLE2,RADIUS2+MOVE2,TH*SIGN2,ROT2) LET Y3=Y2+FY(POLY2,CYCLE2,RADIUS2+MOVE2,TH*SIGN2,ROT2) LET X4=X3+FX(POLY3,CYCLE3,RADIUS3+MOVE3,TH*SIGN3,ROT3) LET Y4=Y3+FY(POLY3,CYCLE3,RADIUS3+MOVE3,TH*SIGN3,ROT3) LET X5=X4+FX(POLY4,CYCLE4,RADIUS4+MOVE4,TH*SIGN4,ROT4) LET Y5=Y4+FY(POLY4,CYCLE4,RADIUS4+MOVE4,TH*SIGN4,ROT4) LET X6=X5+FX(POLY5,CYCLE5,RADIUS5+MOVE5,TH*SIGN5,ROT5) LET Y6=Y5+FY(POLY5,CYCLE5,RADIUS5+MOVE5,TH*SIGN5,ROT5) LET X7=X6+FX(POLY6,CYCLE6,RADIUS6+MOVE6,TH*SIGN6,ROT6) LET Y7=Y6+FY(POLY6,CYCLE6,RADIUS6+MOVE6,TH*SIGN6,ROT6) LET X8=X7+FX(POLY7,CYCLE7,RADIUS7+MOVE7,TH*SIGN7,ROT7) LET Y8=Y7+FY(POLY7,CYCLE7,RADIUS7+MOVE7,TH*SIGN7,ROT7) LET X9=X8+FX(POLY8,CYCLE8,RADIUS8+MOVE8,TH*SIGN8,ROT8) LET Y9=Y8+FY(POLY8,CYCLE8,RADIUS8+MOVE8,TH*SIGN8,ROT8) CALL POLY(X1,Y1,RADIUS1,COL1,POLY1,ROT1) CALL POLY(X2,Y2,RADIUS2,COL2,POLY2,ROT2) CALL POLY(X3,Y3,RADIUS3,COL3,POLY3,ROT3) CALL POLY(X4,Y4,RADIUS4,COL4,POLY4,ROT4) CALL POLY(X5,Y5,RADIUS5,COL5,POLY5,ROT5) CALL POLY(X6,Y6,RADIUS6,COL6,POLY6,ROT6) CALL POLY(X7,Y7,RADIUS7,COL7,POLY7,ROT7) CALL POLY(X8,Y8,RADIUS8,COL8,POLY8,ROT8) SET LINE COLOR COL9 PLOT LINES:X1,Y1;X2,Y2;X3,Y3;X4,Y4;X5,Y5;X6,Y6;X7,Y7;X8,Y8;X9,Y9 SET LINE COLOR COL10 PLOT LINES FOR TT=0 TO TH LET X= FX(POLY1,CYCLE1,RADIUS1+MOVE1,TT*SIGN1,ROT1)+FX(POLY2,CYCLE2,RADIUS2+MOVE2,TT*SIGN2,ROT2)+FX(POLY3,CYCLE3,RADIUS3+MOVE3,TT*SIGN3,ROT3)+FX(POLY4,CYCLE4,RADIUS4+MOVE4,TT*SIGN4,ROT4) LET Y= FY(POLY1,CYCLE1,RADIUS1+MOVE1,TT*SIGN1,ROT1)+FY(POLY2,CYCLE2,RADIUS2+MOVE2,TT*SIGN2,ROT2)+FY(POLY3,CYCLE3,RADIUS3+MOVE3,TT*SIGN3,ROT3)+FY(POLY4,CYCLE4,RADIUS4+MOVE4,TT*SIGN4,ROT4) LET X=X+FX(POLY5,CYCLE5,RADIUS5+MOVE5,TT*SIGN5,ROT5)+FX(POLY6,CYCLE6,RADIUS6+MOVE6,TT*SIGN6,ROT6)+FX(POLY7,CYCLE7,RADIUS7+MOVE7,TT*SIGN7,ROT7)+FX(POLY8,CYCLE8,RADIUS8+MOVE8,TT*SIGN8,ROT8) LET Y=Y+FY(POLY5,CYCLE5,RADIUS5+MOVE5,TT*SIGN5,ROT5)+FY(POLY6,CYCLE6,RADIUS6+MOVE6,TT*SIGN6,ROT6)+FY(POLY7,CYCLE7,RADIUS7+MOVE7,TT*SIGN7,ROT7)+FY(POLY8,CYCLE8,RADIUS8+MOVE8,TT*SIGN8,ROT8) PLOT LINES:X,Y; NEXT TT SET DRAW MODE EXPLICIT IF SAVE=1 THEN LET KK=KK+1 GSAVE "image"&USING$("%%%%%",KK)&".png" PRINT "No.";KK END IF WAIT DELAY .1 SET DRAW MODE HIDDEN NEXT TH LOOP UNTIL SAVE=1 AND TH=>359 END EXTERNAL SUB GINIT(XSIZE,YSIZE) SET BITMAP SIZE XSIZE,YSIZE !'SET WINDOW 0 , XSIZE-1 , YSIZE-1, 0 SET POINT STYLE 1 FOR I=0 TO 7 SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1) NEXT I CLEAR END SUB EXTERNAL FUNCTION FX(M,N,R,T,ROT) OPTION ANGLE DEGREES IF M>=3 THEN LET A=360/M LET FX=R*COS(T*N+ROT)*COS(A/2)/COS(A*(T*N/A-IP(T*N/A))-A/2) ELSE LET FX=R*COS(T*N+ROT) END IF END FUNCTION EXTERNAL FUNCTION FY(M,N,R,T,ROT) OPTION ANGLE DEGREES IF M>=3 THEN LET A=360/M LET FY=R*SIN(T*N+ROT)*COS(A/2)/COS(A*(T*N/A-IP(T*N/A))-A/2) ELSE LET FY=R*SIN(T*N+ROT) END IF END FUNCTION EXTERNAL SUB POLY(X,Y,R,C,M,ROT) OPTION ANGLE DEGREES SET LINE COLOR C PLOT LINES IF R>0 THEN FOR T=0 TO 360 IF M>=3 THEN LET A=360/M LET XX=X+R*COS(T+ROT)*COS(A/2)/COS(A*(T/A-IP(T/A))-A/2) LET YY=Y+R*SIN(T+ROT)*COS(A/2)/COS(A*(T/A-IP(T/A))-A/2) ELSE LET XX=X+R*COS(T) LET YY=Y+R*SIN(T) END IF PLOT LINES:XX,YY; NEXT T END IF PLOT LINES END SUB

グラフィックデモ

投稿者：しばっち投稿日：2018年12月16日(日)10時44分51秒

グラフイックデモ。(星型) トロコイドを星形で行ってみました。パラメーターPOLYを5未満にすると円になります 'S'キーで画像セーブしますスペースキーで切り替えてください CALL GINIT(800,800) OPTION ANGLE DEGREES DIM C(8),T(8),R(8),P(8),CL(10),M(8),S(8) MAT READ C READ CYCLE1,CYCLE2,CYCLE3,CYCLE4,CYCLE5,CYCLE6,CYCLE7,CYCLE8 DATA 1,2,3,4,5,6,7,8 DATA 1,2,3,4,5,6,7,8 MAT READ R READ RADIUS1,RADIUS2,RADIUS3,RADIUS4,RADIUS5,RADIUS6,RADIUS7,RADIUS8 DATA 1,.5,0,0,0,0,0,0 DATA 1,.5,0,0,0,0,0,0 MAT READ P READ POLY1,POLY2,POLY3,POLY4,POLY5,POLY6,POLY7,POLY8 DATA 5,5,5,5,5,5,5,5 DATA 5,5,5,5,5,5,5,5 MAT READ CL READ COL1,COL2,COL3,COL4,COL5,COL6,COL7,COL8,COL9,COL10 DATA 1,2,3,4,8,9,10,11,5.5,7.5 DATA 1,2,3,4,8,9,10,11,5.5,7.5 MAT READ S READ SIGN1,SIGN2,SIGN3,SIGN4,SIGN5,SIGN6,SIGN7,SIGN8 DATA 1,1,1,1,1,1,1,1 DATA 1,1,1,1,1,1,1,1 LET SP=3.01 LET SPEED=SP LET SC=4.01 LET SCALE=SC LET KEY$="PCRTKMX" DO FOR TH=0 TO 359 STEP SPEED IF SAVE=0 THEN IF GETKEYSTATE(ORD("S"))<0 THEN LET SAVE=1 PRINT "セーブ開始" EXIT FOR END IF FOR I=1 TO LEN(KEY$) IF GETKEYSTATE(ORD(KEY$(I:I)))<0 THEN LET PAGE=I-1 LET FLG=0 EXIT FOR END IF NEXT I IF GETKEYSTATE(27)<0 THEN STOP IF GETKEYSTATE(32)<0 THEN DO LOOP WHILE GETKEYSTATE(32)<0 LET PAGE=MOD(PAGE+1,7) LET FLG=0 END IF SELECT CASE PAGE CASE 0 !'角数 IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE 4 TO 10,AT P(1):POLY1 LOCATE VALUE NOWAIT(2),RANGE 4 TO 10,AT P(2):POLY2 LOCATE VALUE NOWAIT(3),RANGE 4 TO 10,AT P(3):POLY3 LOCATE VALUE NOWAIT(4),RANGE 4 TO 10,AT P(4):POLY4 LOCATE VALUE NOWAIT(5),RANGE 4 TO 10,AT P(5):POLY5 LOCATE VALUE NOWAIT(6),RANGE 4 TO 10,AT P(6):POLY6 LOCATE VALUE NOWAIT(7),RANGE 4 TO 10,AT P(7):POLY7 LOCATE VALUE NOWAIT(8),RANGE 4 TO 10,AT P(8):POLY8 LOCATE VALUE NOWAIT(9),RANGE 1 TO 20,AT SP:SPEED LOCATE VALUE NOWAIT(10),RANGE 1 TO 10,AT SC:SCALE LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):POLY1 LOCATE VALUE NOWAIT(2):POLY2 LOCATE VALUE NOWAIT(3):POLY3 LOCATE VALUE NOWAIT(4):POLY4 LOCATE VALUE NOWAIT(5):POLY5 LOCATE VALUE NOWAIT(6):POLY6 LOCATE VALUE NOWAIT(7):POLY7 LOCATE VALUE NOWAIT(8):POLY8 LOCATE VALUE NOWAIT(9):SPEED LOCATE VALUE NOWAIT(10):SCALE LET P(1)=POLY1 LET P(2)=POLY2 LET P(3)=POLY3 LET P(4)=POLY4 LET P(5)=POLY5 LET P(6)=POLY6 LET P(7)=POLY7 LET P(8)=POLY8 LET SP=SPEED LET SC=SCALE END IF CASE 1 !'周期 IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE 0 TO 20,AT C(1):CYCLE1 LOCATE VALUE NOWAIT(2),RANGE 0 TO 20,AT C(2):CYCLE2 LOCATE VALUE NOWAIT(3),RANGE 0 TO 20,AT C(3):CYCLE3 LOCATE VALUE NOWAIT(4),RANGE 0 TO 20,AT C(4):CYCLE4 LOCATE VALUE NOWAIT(5),RANGE 0 TO 20,AT C(5):CYCLE5 LOCATE VALUE NOWAIT(6),RANGE 0 TO 20,AT C(6):CYCLE6 LOCATE VALUE NOWAIT(7),RANGE 0 TO 20,AT C(7):CYCLE7 LOCATE VALUE NOWAIT(8),RANGE 0 TO 20,AT C(8):CYCLE8 LOCATE VALUE NOWAIT(9),RANGE 1 TO 20,AT SP:SPEED LOCATE VALUE NOWAIT(10),RANGE 1 TO 10,AT SC:SCALE LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):CYCLE1 LOCATE VALUE NOWAIT(2):CYCLE2 LOCATE VALUE NOWAIT(3):CYCLE3 LOCATE VALUE NOWAIT(4):CYCLE4 LOCATE VALUE NOWAIT(5):CYCLE5 LOCATE VALUE NOWAIT(6):CYCLE6 LOCATE VALUE NOWAIT(7):CYCLE7 LOCATE VALUE NOWAIT(8):CYCLE8 LOCATE VALUE NOWAIT(9):SPEED LOCATE VALUE NOWAIT(10):SCALE LET C(1)=CYCLE1 LET C(2)=CYCLE2 LET C(3)=CYCLE3 LET C(4)=CYCLE4 LET C(5)=CYCLE5 LET C(6)=CYCLE6 LET C(7)=CYCLE7 LET C(8)=CYCLE8 LET SP=SPEED LET SC=SCALE END IF CASE 2 !'半径 IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE 0 TO 1,AT R(1):RADIUS1 LOCATE VALUE NOWAIT(2),RANGE 0 TO 1,AT R(2):RADIUS2 LOCATE VALUE NOWAIT(3),RANGE 0 TO 1,AT R(3):RADIUS3 LOCATE VALUE NOWAIT(4),RANGE 0 TO 1,AT R(4):RADIUS4 LOCATE VALUE NOWAIT(5),RANGE 0 TO 1,AT R(5):RADIUS5 LOCATE VALUE NOWAIT(6),RANGE 0 TO 1,AT R(6):RADIUS6 LOCATE VALUE NOWAIT(7),RANGE 0 TO 1,AT R(7):RADIUS7 LOCATE VALUE NOWAIT(8),RANGE 0 TO 1,AT R(8):RADIUS8 LOCATE VALUE NOWAIT(9),RANGE 1 TO 20,AT SP:SPEED LOCATE VALUE NOWAIT(10),RANGE 1 TO 10,AT SC:SCALE LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):RADIUS1 LOCATE VALUE NOWAIT(2):RADIUS2 LOCATE VALUE NOWAIT(3):RADIUS3 LOCATE VALUE NOWAIT(4):RADIUS4 LOCATE VALUE NOWAIT(5):RADIUS5 LOCATE VALUE NOWAIT(6):RADIUS6 LOCATE VALUE NOWAIT(7):RADIUS7 LOCATE VALUE NOWAIT(8):RADIUS8 LOCATE VALUE NOWAIT(9):SPEED LOCATE VALUE NOWAIT(10):SCALE LET R(1)=RADIUS1 LET R(2)=RADIUS2 LET R(3)=RADIUS3 LET R(4)=RADIUS4 LET R(5)=RADIUS5 LET R(6)=RADIUS6 LET R(7)=RADIUS7 LET R(8)=RADIUS8 LET SP=SPEED LET SC=SCALE END IF CASE 3 !'開始角度 IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE 0 TO 359,AT T(1):ROT1 LOCATE VALUE NOWAIT(2),RANGE 0 TO 359,AT T(2):ROT2 LOCATE VALUE NOWAIT(3),RANGE 0 TO 359,AT T(3):ROT3 LOCATE VALUE NOWAIT(4),RANGE 0 TO 359,AT T(4):ROT4 LOCATE VALUE NOWAIT(5),RANGE 0 TO 359,AT T(5):ROT5 LOCATE VALUE NOWAIT(6),RANGE 0 TO 359,AT T(6):ROT6 LOCATE VALUE NOWAIT(7),RANGE 0 TO 359,AT T(7):ROT7 LOCATE VALUE NOWAIT(8),RANGE 0 TO 359,AT T(8):ROT8 LOCATE VALUE NOWAIT(9),RANGE 1 TO 20,AT SP:SPEED LOCATE VALUE NOWAIT(10),RANGE 1 TO 10,AT SC:SCALE LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):ROT1 LOCATE VALUE NOWAIT(2):ROT2 LOCATE VALUE NOWAIT(3):ROT3 LOCATE VALUE NOWAIT(4):ROT4 LOCATE VALUE NOWAIT(5):ROT5 LOCATE VALUE NOWAIT(6):ROT6 LOCATE VALUE NOWAIT(7):ROT7 LOCATE VALUE NOWAIT(8):ROT8 LOCATE VALUE NOWAIT(9):SPEED LOCATE VALUE NOWAIT(10):SCALE LET T(1)=ROT1 LET T(2)=ROT2 LET T(3)=ROT3 LET T(4)=ROT4 LET T(5)=ROT5 LET T(6)=ROT6 LET T(7)=ROT7 LET T(8)=ROT8 LET SP=SPEED LET SC=SCALE END IF CASE 4 !'色 IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE 0 TO 255,AT CL(1):COL1 LOCATE VALUE NOWAIT(2),RANGE 0 TO 255,AT CL(2):COL2 LOCATE VALUE NOWAIT(3),RANGE 0 TO 255,AT CL(3):COL3 LOCATE VALUE NOWAIT(4),RANGE 0 TO 255,AT CL(4):COL4 LOCATE VALUE NOWAIT(5),RANGE 0 TO 255,AT CL(5):COL5 LOCATE VALUE NOWAIT(6),RANGE 0 TO 255,AT CL(6):COL6 LOCATE VALUE NOWAIT(7),RANGE 0 TO 255,AT CL(7):COL7 LOCATE VALUE NOWAIT(8),RANGE 0 TO 255,AT CL(8):COL8 LOCATE VALUE NOWAIT(9),RANGE 0 TO 255,AT CL(9):COL9 LOCATE VALUE NOWAIT(10),RANGE 0 TO 255,AT CL(10):COL10 LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):COL1 LOCATE VALUE NOWAIT(2):COL2 LOCATE VALUE NOWAIT(3):COL3 LOCATE VALUE NOWAIT(4):COL4 LOCATE VALUE NOWAIT(5):COL5 LOCATE VALUE NOWAIT(6):COL6 LOCATE VALUE NOWAIT(7):COL7 LOCATE VALUE NOWAIT(8):COL8 LOCATE VALUE NOWAIT(9):COL9 LOCATE VALUE NOWAIT(10):COL10 LET CL(1)=COL1 LET CL(2)=COL2 LET CL(3)=COL3 LET CL(4)=COL4 LET CL(5)=COL5 LET CL(6)=COL6 LET CL(7)=COL7 LET CL(8)=COL8 LET CL(9)=COL9 LET CL(10)=COL10 END IF CASE 5 !'平行移動 IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE -1 TO 1,AT M(1):MOVE1 LOCATE VALUE NOWAIT(2),RANGE -1 TO 1,AT M(2):MOVE2 LOCATE VALUE NOWAIT(3),RANGE -1 TO 1,AT M(3):MOVE3 LOCATE VALUE NOWAIT(4),RANGE -1 TO 1,AT M(4):MOVE4 LOCATE VALUE NOWAIT(5),RANGE -1 TO 1,AT M(5):MOVE5 LOCATE VALUE NOWAIT(6),RANGE -1 TO 1,AT M(6):MOVE6 LOCATE VALUE NOWAIT(7),RANGE -1 TO 1,AT M(7):MOVE7 LOCATE VALUE NOWAIT(8),RANGE -1 TO 1,AT M(8):MOVE8 LOCATE VALUE NOWAIT(9),RANGE 1 TO 20,AT SP:SPEED LOCATE VALUE NOWAIT(10),RANGE 1 TO 10,AT SC:SCALE LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):MOVE1 LOCATE VALUE NOWAIT(2):MOVE2 LOCATE VALUE NOWAIT(3):MOVE3 LOCATE VALUE NOWAIT(4):MOVE4 LOCATE VALUE NOWAIT(5):MOVE5 LOCATE VALUE NOWAIT(6):MOVE6 LOCATE VALUE NOWAIT(7):MOVE7 LOCATE VALUE NOWAIT(8):MOVE8 LOCATE VALUE NOWAIT(9):SPEED LOCATE VALUE NOWAIT(10):SCALE LET M(1)=MOVE1 LET M(2)=MOVE2 LET M(3)=MOVE3 LET M(4)=MOVE4 LET M(5)=MOVE5 LET M(6)=MOVE6 LET M(7)=MOVE7 LET M(8)=MOVE8 LET SP=SPEED LET SC=SCALE END IF CASE 6 !'回転の向き IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE -1 TO 1,AT S(1):SIGN1 LOCATE VALUE NOWAIT(2),RANGE -1 TO 1,AT S(2):SIGN2 LOCATE VALUE NOWAIT(3),RANGE -1 TO 1,AT S(3):SIGN3 LOCATE VALUE NOWAIT(4),RANGE -1 TO 1,AT S(4):SIGN4 LOCATE VALUE NOWAIT(5),RANGE -1 TO 1,AT S(5):SIGN5 LOCATE VALUE NOWAIT(6),RANGE -1 TO 1,AT S(6):SIGN6 LOCATE VALUE NOWAIT(7),RANGE -1 TO 1,AT S(7):SIGN7 LOCATE VALUE NOWAIT(8),RANGE -1 TO 1,AT S(8):SIGN8 LOCATE VALUE NOWAIT(9),RANGE 1 TO 20,AT SP:SPEED LOCATE VALUE NOWAIT(10),RANGE 1 TO 10,AT SC:SCALE LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):SIGN1 LOCATE VALUE NOWAIT(2):SIGN2 LOCATE VALUE NOWAIT(3):SIGN3 LOCATE VALUE NOWAIT(4):SIGN4 LOCATE VALUE NOWAIT(5):SIGN5 LOCATE VALUE NOWAIT(6):SIGN6 LOCATE VALUE NOWAIT(7):SIGN7 LOCATE VALUE NOWAIT(8):SIGN8 LOCATE VALUE NOWAIT(9):SPEED LOCATE VALUE NOWAIT(10):SCALE LET S(1)=SIGN1 LET S(2)=SIGN2 LET S(3)=SIGN3 LET S(4)=SIGN4 LET S(5)=SIGN5 LET S(6)=SIGN6 LET S(7)=SIGN7 LET S(8)=SIGN8 LET SP=SPEED LET SC=SCALE END IF END SELECT END IF SET WINDOW -SCALE,SCALE,-SCALE,SCALE LET POLY1=INT(POLY1) LET POLY2=INT(POLY2) LET POLY3=INT(POLY3) LET POLY4=INT(POLY4) LET POLY5=INT(POLY5) LET POLY6=INT(POLY6) LET POLY7=INT(POLY7) LET POLY8=INT(POLY8) LET CYCLE1=INT(CYCLE1) LET CYCLE2=INT(CYCLE2) LET CYCLE3=INT(CYCLE3) LET CYCLE4=INT(CYCLE4) LET CYCLE5=INT(CYCLE5) LET CYCLE6=INT(CYCLE6) LET CYCLE7=INT(CYCLE7) LET CYCLE8=INT(CYCLE8) LET COL1=INT(COL1) LET COL2=INT(COL2) LET COL3=INT(COL3) LET COL4=INT(COL4) LET COL5=INT(COL5) LET COL6=INT(COL6) LET COL7=INT(COL7) LET COL8=INT(COL8) LET COL9=INT(COL9) LET COL10=INT(COL10) IF SIGN1>=0 THEN LET SIGN1=1 ELSE LET SIGN1=-1 IF SIGN2>=0 THEN LET SIGN2=1 ELSE LET SIGN2=-1 IF SIGN3>=0 THEN LET SIGN3=1 ELSE LET SIGN3=-1 IF SIGN4>=0 THEN LET SIGN4=1 ELSE LET SIGN4=-1 IF SIGN5>=0 THEN LET SIGN5=1 ELSE LET SIGN5=-1 IF SIGN6>=0 THEN LET SIGN6=1 ELSE LET SIGN6=-1 IF SIGN7>=0 THEN LET SIGN7=1 ELSE LET SIGN7=-1 IF SIGN8>=0 THEN LET SIGN8=1 ELSE LET SIGN8=-1 LET SPEED=INT(SPEED) IF SPEED<>SPE THEN LET SPE=SPEED EXIT FOR END IF CLEAR DRAW GRID LET X1=0 LET Y1=0 LET X2=FX(POLY1,CYCLE1,RADIUS1+MOVE1,TH*SIGN1,ROT1) LET Y2=FY(POLY1,CYCLE1,RADIUS1+MOVE1,TH*SIGN1,ROT1) LET X3=X2+FX(POLY2,CYCLE2,RADIUS2+MOVE2,TH*SIGN2,ROT2) LET Y3=Y2+FY(POLY2,CYCLE2,RADIUS2+MOVE2,TH*SIGN2,ROT2) LET X4=X3+FX(POLY3,CYCLE3,RADIUS3+MOVE3,TH*SIGN3,ROT3) LET Y4=Y3+FY(POLY3,CYCLE3,RADIUS3+MOVE3,TH*SIGN3,ROT3) LET X5=X4+FX(POLY4,CYCLE4,RADIUS4+MOVE4,TH*SIGN4,ROT4) LET Y5=Y4+FY(POLY4,CYCLE4,RADIUS4+MOVE4,TH*SIGN4,ROT4) LET X6=X5+FX(POLY5,CYCLE5,RADIUS5+MOVE5,TH*SIGN5,ROT5) LET Y6=Y5+FY(POLY5,CYCLE5,RADIUS5+MOVE5,TH*SIGN5,ROT5) LET X7=X6+FX(POLY6,CYCLE6,RADIUS6+MOVE6,TH*SIGN6,ROT6) LET Y7=Y6+FY(POLY6,CYCLE6,RADIUS6+MOVE6,TH*SIGN6,ROT6) LET X8=X7+FX(POLY7,CYCLE7,RADIUS7+MOVE7,TH*SIGN7,ROT7) LET Y8=Y7+FY(POLY7,CYCLE7,RADIUS7+MOVE7,TH*SIGN7,ROT7) LET X9=X8+FX(POLY8,CYCLE8,RADIUS8+MOVE8,TH*SIGN8,ROT8) LET Y9=Y8+FY(POLY8,CYCLE8,RADIUS8+MOVE8,TH*SIGN8,ROT8) CALL POLY(X1,Y1,RADIUS1,COL1,POLY1,ROT1) CALL POLY(X2,Y2,RADIUS2,COL2,POLY2,ROT2) CALL POLY(X3,Y3,RADIUS3,COL3,POLY3,ROT3) CALL POLY(X4,Y4,RADIUS4,COL4,POLY4,ROT4) CALL POLY(X5,Y5,RADIUS5,COL5,POLY5,ROT5) CALL POLY(X6,Y6,RADIUS6,COL6,POLY6,ROT6) CALL POLY(X7,Y7,RADIUS7,COL7,POLY7,ROT7) CALL POLY(X8,Y8,RADIUS8,COL8,POLY8,ROT8) SET LINE COLOR COL9 PLOT LINES:X1,Y1;X2,Y2;X3,Y3;X4,Y4;X5,Y5;X6,Y6;X7,Y7;X8,Y8;X9,Y9 SET LINE COLOR COL10 PLOT LINES FOR TT=0 TO TH LET X= FX(POLY1,CYCLE1,RADIUS1+MOVE1,TT*SIGN1,ROT1)+FX(POLY2,CYCLE2,RADIUS2+MOVE2,TT*SIGN2,ROT2)+FX(POLY3,CYCLE3,RADIUS3+MOVE3,TT*SIGN3,ROT3)+FX(POLY4,CYCLE4,RADIUS4+MOVE4,TT*SIGN4,ROT4) LET Y= FY(POLY1,CYCLE1,RADIUS1+MOVE1,TT*SIGN1,ROT1)+FY(POLY2,CYCLE2,RADIUS2+MOVE2,TT*SIGN2,ROT2)+FY(POLY3,CYCLE3,RADIUS3+MOVE3,TT*SIGN3,ROT3)+FY(POLY4,CYCLE4,RADIUS4+MOVE4,TT*SIGN4,ROT4) LET X=X+FX(POLY5,CYCLE5,RADIUS5+MOVE5,TT*SIGN5,ROT5)+FX(POLY6,CYCLE6,RADIUS6+MOVE6,TT*SIGN6,ROT6)+FX(POLY7,CYCLE7,RADIUS7+MOVE7,TT*SIGN7,ROT7)+FX(POLY8,CYCLE8,RADIUS8+MOVE8,TT*SIGN8,ROT8) LET Y=Y+FY(POLY5,CYCLE5,RADIUS5+MOVE5,TT*SIGN5,ROT5)+FY(POLY6,CYCLE6,RADIUS6+MOVE6,TT*SIGN6,ROT6)+FY(POLY7,CYCLE7,RADIUS7+MOVE7,TT*SIGN7,ROT7)+FY(POLY8,CYCLE8,RADIUS8+MOVE8,TT*SIGN8,ROT8) PLOT LINES:X,Y; NEXT TT SET DRAW MODE EXPLICIT IF SAVE=1 THEN LET KK=KK+1 GSAVE "image"&USING$("%%%%%",KK)&".png" PRINT "No.";KK END IF WAIT DELAY .1 SET DRAW MODE HIDDEN NEXT TH LOOP UNTIL SAVE=1 AND TH=>359 END EXTERNAL SUB GINIT(XSIZE,YSIZE) SET BITMAP SIZE XSIZE,YSIZE !'SET WINDOW 0 , XSIZE-1 , YSIZE-1, 0 SET POINT STYLE 1 FOR I=0 TO 7 SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1) NEXT I CLEAR END SUB EXTERNAL FUNCTION FX(M,N,R,T,ROT) OPTION ANGLE DEGREES IF M>=5 THEN LET A=360/M LET FX=R*COS(T*N+ROT)*COS(A)/COS(A-1/M*ACOS(COS(N*M*T))) ELSE LET FX=R*COS(T*N+ROT) END IF END FUNCTION EXTERNAL FUNCTION FY(M,N,R,T,ROT) OPTION ANGLE DEGREES IF M>=5 THEN LET A=360/M LET FY=R*SIN(T*N+ROT)*COS(A)/COS(A-1/M*ACOS(COS(N*M*T))) ELSE LET FY=R*SIN(T*N+ROT) END IF END FUNCTION EXTERNAL SUB POLY(X,Y,R,C,M,ROT) OPTION ANGLE DEGREES SET LINE COLOR C PLOT LINES IF R>0 THEN FOR T=0 TO 360 IF M>=5 THEN LET A=360/M LET XX=X+R*COS(T+ROT)*COS(A)/COS(A-1/M*ACOS(COS(M*T))) LET YY=Y+R*SIN(T+ROT)*COS(A)/COS(A-1/M*ACOS(COS(M*T))) ELSE LET XX=X+R*COS(T) LET YY=Y+R*SIN(T) END IF PLOT LINES:XX,YY; NEXT T END IF PLOT LINES END SUB

グラフィックデモ

投稿者：しばっち投稿日：2018年12月16日(日)10時45分36秒

グラフイックデモ。(リサージュ) トロコイドをリサージュ曲線で行ってみました。 'S'キーで画像セーブしますスペースキーで切り替えてください CALL GINIT(800,800) OPTION ANGLE DEGREES DIM C1(8),C2(8),T(8),R(8),CL(10),M(8),S(8) MAT READ C1 READ XCYCLE1,YCYCLE1,XCYCLE2,YCYCLE2,XCYCLE3,YCYCLE3,XCYCLE4,YCYCLE4 DATA 1,2,1,3,1,4,1,5 DATA 1,2,1,3,1,4,1,5 MAT READ C2 READ XCYCLE5,YCYCLE5,XCYCLE6,YCYCLE6,XCYCLE7,YCYCLE7,XCYCLE8,YCYCLE8 DATA 1,6,1,7,1,8,1,9 DATA 1,6,1,7,1,8,1,9 MAT READ R READ RADIUS1,RADIUS2,RADIUS3,RADIUS4,RADIUS5,RADIUS6,RADIUS7,RADIUS8 DATA 1,.5,0,0,0,0,0,0 DATA 1,.5,0,0,0,0,0,0 MAT READ CL READ COL1,COL2,COL3,COL4,COL5,COL6,COL7,COL8,COL9,COL10 DATA 1.1,2.1,3.1,4.1,8.1,9.1,10.1,11.1,5.1,7.1 DATA 1.1,2.1,3.1,4.1,8.1,9.1,10.1,11.1,5.1,7.1 MAT READ S READ SIGN1,SIGN2,SIGN3,SIGN4,SIGN5,SIGN6,SIGN7,SIGN8 DATA 1,1,1,1,1,1,1,1 DATA 1,1,1,1,1,1,1,1 LET SP=3.01 LET SPEED=SP LET SC=4.01 LET SCALE=SC LET KEY$="CVRTKMX" DO FOR TH=0 TO 359 STEP SPEED IF SAVE=0 THEN IF GETKEYSTATE(ORD("S"))<0 THEN LET SAVE=1 PRINT "セーブ開始" EXIT FOR END IF FOR I=1 TO LEN(KEY$) IF GETKEYSTATE(ORD(KEY$(I:I)))<0 THEN LET PAGE=I-1 LET FLG=0 EXIT FOR END IF NEXT I IF GETKEYSTATE(27)<0 THEN STOP IF GETKEYSTATE(32)<0 THEN DO LOOP WHILE GETKEYSTATE(32)<0 LET PAGE=MOD(PAGE+1,7) LET FLG=0 END IF SELECT CASE PAGE CASE 0 !'周期 IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE 0 TO 20,AT C1(1):XCYCLE1 !'バーの並びに注意(1～4) LOCATE VALUE NOWAIT(2),RANGE 0 TO 20,AT C1(2):YCYCLE1 LOCATE VALUE NOWAIT(3),RANGE 0 TO 20,AT C1(3):XCYCLE2 LOCATE VALUE NOWAIT(4),RANGE 0 TO 20,AT C1(4):YCYCLE2 LOCATE VALUE NOWAIT(5),RANGE 0 TO 20,AT C1(5):XCYCLE3 LOCATE VALUE NOWAIT(6),RANGE 0 TO 20,AT C1(6):YCYCLE3 LOCATE VALUE NOWAIT(7),RANGE 0 TO 20,AT C1(7):XCYCLE4 LOCATE VALUE NOWAIT(8),RANGE 0 TO 20,AT C1(8):YCYCLE4 LOCATE VALUE NOWAIT(9),RANGE 1 TO 20,AT SP:SPEED LOCATE VALUE NOWAIT(10),RANGE 1 TO 10,AT SC:SCALE LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):XCYCLE1 LOCATE VALUE NOWAIT(2):YCYCLE1 LOCATE VALUE NOWAIT(3):XCYCLE2 LOCATE VALUE NOWAIT(4):YCYCLE2 LOCATE VALUE NOWAIT(5):XCYCLE3 LOCATE VALUE NOWAIT(6):YCYCLE3 LOCATE VALUE NOWAIT(7):XCYCLE4 LOCATE VALUE NOWAIT(8):YCYCLE4 LOCATE VALUE NOWAIT(9):SPEED LOCATE VALUE NOWAIT(10):SCALE LET C1(1)=XCYCLE1 LET C1(2)=YCYCLE1 LET C1(3)=XCYCLE2 LET C1(4)=YCYCLE2 LET C1(5)=XCYCLE3 LET C1(6)=YCYCLE3 LET C1(7)=XCYCLE4 LET C1(8)=YCYCLE4 LET SP=SPEED LET SC=SCALE END IF CASE 1 !'周期 IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE 0 TO 20,AT C2(1):XCYCLE5 !'バーの並びに注意(5～8) LOCATE VALUE NOWAIT(2),RANGE 0 TO 20,AT C2(2):YCYCLE5 LOCATE VALUE NOWAIT(3),RANGE 0 TO 20,AT C2(3):XCYCLE6 LOCATE VALUE NOWAIT(4),RANGE 0 TO 20,AT C2(4):YCYCLE6 LOCATE VALUE NOWAIT(5),RANGE 0 TO 20,AT C2(5):XCYCLE7 LOCATE VALUE NOWAIT(6),RANGE 0 TO 20,AT C2(6):YCYCLE7 LOCATE VALUE NOWAIT(7),RANGE 0 TO 20,AT C2(7):XCYCLE8 LOCATE VALUE NOWAIT(8),RANGE 0 TO 20,AT C2(8):YCYCLE8 LOCATE VALUE NOWAIT(9),RANGE 1 TO 20,AT SP:SPEED LOCATE VALUE NOWAIT(10),RANGE 1 TO 10,AT SC:SCALE LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):XCYCLE5 LOCATE VALUE NOWAIT(2):YCYCLE5 LOCATE VALUE NOWAIT(3):XCYCLE6 LOCATE VALUE NOWAIT(4):YCYCLE6 LOCATE VALUE NOWAIT(5):XCYCLE7 LOCATE VALUE NOWAIT(6):YCYCLE7 LOCATE VALUE NOWAIT(7):XCYCLE8 LOCATE VALUE NOWAIT(8):YCYCLE8 LOCATE VALUE NOWAIT(9):SPEED LOCATE VALUE NOWAIT(10):SCALE LET C2(1)=XCYCLE5 LET C2(2)=YCYCLE5 LET C2(3)=XCYCLE6 LET C2(4)=YCYCLE6 LET C2(5)=XCYCLE7 LET C2(6)=YCYCLE7 LET C2(7)=XCYCLE8 LET C2(8)=YCYCLE8 LET SP=SPEED LET SC=SCALE END IF CASE 2 !'半径 IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE 0 TO 1,AT R(1):RADIUS1 LOCATE VALUE NOWAIT(2),RANGE 0 TO 1,AT R(2):RADIUS2 LOCATE VALUE NOWAIT(3),RANGE 0 TO 1,AT R(3):RADIUS3 LOCATE VALUE NOWAIT(4),RANGE 0 TO 1,AT R(4):RADIUS4 LOCATE VALUE NOWAIT(5),RANGE 0 TO 1,AT R(5):RADIUS5 LOCATE VALUE NOWAIT(6),RANGE 0 TO 1,AT R(6):RADIUS6 LOCATE VALUE NOWAIT(7),RANGE 0 TO 1,AT R(7):RADIUS7 LOCATE VALUE NOWAIT(8),RANGE 0 TO 1,AT R(8):RADIUS8 LOCATE VALUE NOWAIT(9),RANGE 1 TO 20,AT SP:SPEED LOCATE VALUE NOWAIT(10),RANGE 1 TO 10,AT SC:SCALE LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):RADIUS1 LOCATE VALUE NOWAIT(2):RADIUS2 LOCATE VALUE NOWAIT(3):RADIUS3 LOCATE VALUE NOWAIT(4):RADIUS4 LOCATE VALUE NOWAIT(5):RADIUS5 LOCATE VALUE NOWAIT(6):RADIUS6 LOCATE VALUE NOWAIT(7):RADIUS7 LOCATE VALUE NOWAIT(8):RADIUS8 LOCATE VALUE NOWAIT(9):SPEED LOCATE VALUE NOWAIT(10):SCALE LET R(1)=RADIUS1 LET R(2)=RADIUS2 LET R(3)=RADIUS3 LET R(4)=RADIUS4 LET R(5)=RADIUS5 LET R(6)=RADIUS6 LET R(7)=RADIUS7 LET R(8)=RADIUS8 LET SP=SPEED LET SC=SCALE END IF CASE 3 !'開始角度 IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE 0 TO 359,AT T(1):ROT1 LOCATE VALUE NOWAIT(2),RANGE 0 TO 359,AT T(2):ROT2 LOCATE VALUE NOWAIT(3),RANGE 0 TO 359,AT T(3):ROT3 LOCATE VALUE NOWAIT(4),RANGE 0 TO 359,AT T(4):ROT4 LOCATE VALUE NOWAIT(5),RANGE 0 TO 359,AT T(5):ROT5 LOCATE VALUE NOWAIT(6),RANGE 0 TO 359,AT T(6):ROT6 LOCATE VALUE NOWAIT(7),RANGE 0 TO 359,AT T(7):ROT7 LOCATE VALUE NOWAIT(8),RANGE 0 TO 359,AT T(8):ROT8 LOCATE VALUE NOWAIT(9),RANGE 1 TO 20,AT SP:SPEED LOCATE VALUE NOWAIT(10),RANGE 1 TO 10,AT SC:SCALE LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):ROT1 LOCATE VALUE NOWAIT(2):ROT2 LOCATE VALUE NOWAIT(3):ROT3 LOCATE VALUE NOWAIT(4):ROT4 LOCATE VALUE NOWAIT(5):ROT5 LOCATE VALUE NOWAIT(6):ROT6 LOCATE VALUE NOWAIT(7):ROT7 LOCATE VALUE NOWAIT(8):ROT8 LOCATE VALUE NOWAIT(9):SPEED LOCATE VALUE NOWAIT(10):SCALE LET T(1)=ROT1 LET T(2)=ROT2 LET T(3)=ROT3 LET T(4)=ROT4 LET T(5)=ROT5 LET T(6)=ROT6 LET T(7)=ROT7 LET T(8)=ROT8 LET SP=SPEED LET SC=SCALE END IF CASE 4 !'色 IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE 0 TO 255,AT CL(1):COL1 LOCATE VALUE NOWAIT(2),RANGE 0 TO 255,AT CL(2):COL2 LOCATE VALUE NOWAIT(3),RANGE 0 TO 255,AT CL(3):COL3 LOCATE VALUE NOWAIT(4),RANGE 0 TO 255,AT CL(4):COL4 LOCATE VALUE NOWAIT(5),RANGE 0 TO 255,AT CL(5):COL5 LOCATE VALUE NOWAIT(6),RANGE 0 TO 255,AT CL(6):COL6 LOCATE VALUE NOWAIT(7),RANGE 0 TO 255,AT CL(7):COL7 LOCATE VALUE NOWAIT(8),RANGE 0 TO 255,AT CL(8):COL8 LOCATE VALUE NOWAIT(9),RANGE 0 TO 255,AT CL(9):COL9 LOCATE VALUE NOWAIT(10),RANGE 0 TO 255,AT CL(10):COL10 LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):COL1 LOCATE VALUE NOWAIT(2):COL2 LOCATE VALUE NOWAIT(3):COL3 LOCATE VALUE NOWAIT(4):COL4 LOCATE VALUE NOWAIT(5):COL5 LOCATE VALUE NOWAIT(6):COL6 LOCATE VALUE NOWAIT(7):COL7 LOCATE VALUE NOWAIT(8):COL8 LOCATE VALUE NOWAIT(9):COL9 LOCATE VALUE NOWAIT(10):COL10 LET CL(1)=COL1 LET CL(2)=COL2 LET CL(3)=COL3 LET CL(4)=COL4 LET CL(5)=COL5 LET CL(6)=COL6 LET CL(7)=COL7 LET CL(8)=COL8 LET CL(9)=COL9 LET CL(10)=COL10 END IF CASE 5 !'平行移動 IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE -1 TO 1,AT M(1):MOVE1 LOCATE VALUE NOWAIT(2),RANGE -1 TO 1,AT M(2):MOVE2 LOCATE VALUE NOWAIT(3),RANGE -1 TO 1,AT M(3):MOVE3 LOCATE VALUE NOWAIT(4),RANGE -1 TO 1,AT M(4):MOVE4 LOCATE VALUE NOWAIT(5),RANGE -1 TO 1,AT M(5):MOVE5 LOCATE VALUE NOWAIT(6),RANGE -1 TO 1,AT M(6):MOVE6 LOCATE VALUE NOWAIT(7),RANGE -1 TO 1,AT M(7):MOVE7 LOCATE VALUE NOWAIT(8),RANGE -1 TO 1,AT M(8):MOVE8 LOCATE VALUE NOWAIT(9),RANGE 1 TO 20,AT SP:SPEED LOCATE VALUE NOWAIT(10),RANGE 1 TO 10,AT SC:SCALE LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):MOVE1 LOCATE VALUE NOWAIT(2):MOVE2 LOCATE VALUE NOWAIT(3):MOVE3 LOCATE VALUE NOWAIT(4):MOVE4 LOCATE VALUE NOWAIT(5):MOVE5 LOCATE VALUE NOWAIT(6):MOVE6 LOCATE VALUE NOWAIT(7):MOVE7 LOCATE VALUE NOWAIT(8):MOVE8 LOCATE VALUE NOWAIT(9):SPEED LOCATE VALUE NOWAIT(10):SCALE LET M(1)=MOVE1 LET M(2)=MOVE2 LET M(3)=MOVE3 LET M(4)=MOVE4 LET M(5)=MOVE5 LET M(6)=MOVE6 LET M(7)=MOVE7 LET M(8)=MOVE8 LET SP=SPEED LET SC=SCALE END IF CASE 6 !'回転の向き IF FLG=0 THEN LOCATE VALUE NOWAIT(1),RANGE -1 TO 1,AT S(1):SIGN1 LOCATE VALUE NOWAIT(2),RANGE -1 TO 1,AT S(2):SIGN2 LOCATE VALUE NOWAIT(3),RANGE -1 TO 1,AT S(3):SIGN3 LOCATE VALUE NOWAIT(4),RANGE -1 TO 1,AT S(4):SIGN4 LOCATE VALUE NOWAIT(5),RANGE -1 TO 1,AT S(5):SIGN5 LOCATE VALUE NOWAIT(6),RANGE -1 TO 1,AT S(6):SIGN6 LOCATE VALUE NOWAIT(7),RANGE -1 TO 1,AT S(7):SIGN7 LOCATE VALUE NOWAIT(8),RANGE -1 TO 1,AT S(8):SIGN8 LOCATE VALUE NOWAIT(9),RANGE 1 TO 20,AT SP:SPEED LOCATE VALUE NOWAIT(10),RANGE 1 TO 10,AT SC:SCALE LET FLG=1 ELSE LOCATE VALUE NOWAIT(1):SIGN1 LOCATE VALUE NOWAIT(2):SIGN2 LOCATE VALUE NOWAIT(3):SIGN3 LOCATE VALUE NOWAIT(4):SIGN4 LOCATE VALUE NOWAIT(5):SIGN5 LOCATE VALUE NOWAIT(6):SIGN6 LOCATE VALUE NOWAIT(7):SIGN7 LOCATE VALUE NOWAIT(8):SIGN8 LOCATE VALUE NOWAIT(9):SPEED LOCATE VALUE NOWAIT(10):SCALE LET S(1)=SIGN1 LET S(2)=SIGN2 LET S(3)=SIGN3 LET S(4)=SIGN4 LET S(5)=SIGN5 LET S(6)=SIGN6 LET S(7)=SIGN7 LET S(8)=SIGN8 LET SP=SPEED LET SC=SCALE END IF END SELECT END IF SET WINDOW -SCALE,SCALE,-SCALE,SCALE LET XCYCLE1=INT(XCYCLE1) LET XCYCLE2=INT(XCYCLE2) LET XCYCLE3=INT(XCYCLE3) LET XCYCLE4=INT(XCYCLE4) LET XCYCLE5=INT(XCYCLE5) LET XCYCLE6=INT(XCYCLE6) LET XCYCLE7=INT(XCYCLE7) LET XCYCLE8=INT(XCYCLE8) LET YCYCLE1=INT(YCYCLE1) LET YCYCLE2=INT(YCYCLE2) LET YCYCLE3=INT(YCYCLE3) LET YCYCLE4=INT(YCYCLE4) LET YCYCLE5=INT(YCYCLE5) LET YCYCLE6=INT(YCYCLE6) LET YCYCLE7=INT(YCYCLE7) LET YCYCLE8=INT(YCYCLE8) LET COL1=INT(COL1) LET COL2=INT(COL2) LET COL3=INT(COL3) LET COL4=INT(COL4) LET COL5=INT(COL5) LET COL6=INT(COL6) LET COL7=INT(COL7) LET COL8=INT(COL8) LET COL9=INT(COL9) LET COL10=INT(COL10) IF SIGN1>=0 THEN LET SIGN1=1 ELSE LET SIGN1=-1 IF SIGN2>=0 THEN LET SIGN2=1 ELSE LET SIGN2=-1 IF SIGN3>=0 THEN LET SIGN3=1 ELSE LET SIGN3=-1 IF SIGN4>=0 THEN LET SIGN4=1 ELSE LET SIGN4=-1 IF SIGN5>=0 THEN LET SIGN5=1 ELSE LET SIGN5=-1 IF SIGN6>=0 THEN LET SIGN6=1 ELSE LET SIGN6=-1 IF SIGN7>=0 THEN LET SIGN7=1 ELSE LET SIGN7=-1 IF SIGN8>=0 THEN LET SIGN8=1 ELSE LET SIGN8=-1 LET SPEED=INT(SPEED) IF SPEED<>SPE THEN LET SPE=SPEED EXIT FOR END IF CLEAR DRAW GRID LET X1=0 LET Y1=0 LET X2=(RADIUS1+MOVE1)*COS(TH*XCYCLE1*SIGN1) LET Y2=(RADIUS1+MOVE1)*SIN(TH*YCYCLE1*SIGN1+ROT1) LET X3=X2+(RADIUS2+MOVE2)*COS(TH*XCYCLE2*SIGN2) LET Y3=Y2+(RADIUS2+MOVE2)*SIN(TH*YCYCLE2*SIGN2+ROT2) LET X4=X3+(RADIUS3+MOVE3)*COS(TH*XCYCLE3*SIGN3) LET Y4=Y3+(RADIUS3+MOVE3)*SIN(TH*YCYCLE3*SIGN3+ROT3) LET X5=X4+(RADIUS4+MOVE4)*COS(TH*XCYCLE4*SIGN4) LET Y5=Y4+(RADIUS4+MOVE4)*SIN(TH*YCYCLE4*SIGN4+ROT4) LET X6=X5+(RADIUS5+MOVE5)*COS(TH*XCYCLE5*SIGN5) LET Y6=Y5+(RADIUS5+MOVE5)*SIN(TH*YCYCLE5*SIGN5+ROT5) LET X7=X6+(RADIUS6+MOVE6)*COS(TH*XCYCLE6*SIGN6) LET Y7=Y6+(RADIUS6+MOVE6)*SIN(TH*YCYCLE6*SIGN6+ROT6) LET X8=X7+(RADIUS7+MOVE7)*COS(TH*XCYCLE7*SIGN7) LET Y8=Y7+(RADIUS7+MOVE7)*SIN(TH*YCYCLE7*SIGN7+ROT7) LET X9=X8+(RADIUS8+MOVE8)*COS(TH*XCYCLE8*SIGN8) LET Y9=Y8+(RADIUS8+MOVE8)*SIN(TH*YCYCLE8*SIGN8+ROT8) CALL LISSAJOUS(X1,Y1,RADIUS1,COL1,XCYCLE1,YCYCLE1,ROT1) CALL LISSAJOUS(X2,Y2,RADIUS2,COL2,XCYCLE2,YCYCLE2,ROT2) CALL LISSAJOUS(X3,Y3,RADIUS3,COL3,XCYCLE3,YCYCLE3,ROT3) CALL LISSAJOUS(X4,Y4,RADIUS4,COL4,XCYCLE4,YCYCLE4,ROT4) CALL LISSAJOUS(X5,Y5,RADIUS5,COL5,XCYCLE5,YCYCLE5,ROT5) CALL LISSAJOUS(X6,Y6,RADIUS6,COL6,XCYCLE6,YCYCLE6,ROT6) CALL LISSAJOUS(X7,Y7,RADIUS7,COL7,XCYCLE7,YCYCLE7,ROT7) CALL LISSAJOUS(X8,Y8,RADIUS8,COL8,XCYCLE8,YCYCLE8,ROT8) SET LINE COLOR COL9 PLOT LINES:X1,Y1;X2,Y2;X3,Y3;X4,Y4;X5,Y5;X6,Y6;X7,Y7;X8,Y8;X9,Y9 SET LINE COLOR COL10 PLOT LINES FOR TT=0 TO TH LET X= (RADIUS1+MOVE1)*COS(TT*XCYCLE1*SIGN1)+(RADIUS2+MOVE2)*COS(TT*XCYCLE2*SIGN2)+(RADIUS3+MOVE3)*COS(TT*XCYCLE3*SIGN3)+(RADIUS4+MOVE4)*COS(TT*XCYCLE4*SIGN4) LET Y= (RADIUS1+MOVE1)*SIN(TT*YCYCLE1*SIGN1+ROT1)+(RADIUS2+MOVE2)*SIN(TT*YCYCLE2*SIGN2+ROT2)+(RADIUS3+MOVE3)*SIN(TT*YCYCLE3*SIGN3+ROT3)+(RADIUS4+MOVE4)*SIN(TT*YCYCLE4*SIGN4+ROT4) LET X=X+(RADIUS5+MOVE5)*COS(TT*XCYCLE5*SIGN5)+(RADIUS6+MOVE6)*COS(TT*XCYCLE6*SIGN6)+(RADIUS7+MOVE7)*COS(TT*XCYCLE7*SIGN7)+(RADIUS8+MOVE8)*COS(TT*XCYCLE8*SIGN8) LET Y=Y+(RADIUS5+MOVE5)*SIN(TT*YCYCLE5*SIGN5+ROT5)+(RADIUS6+MOVE6)*SIN(TT*YCYCLE6*SIGN6+ROT6)+(RADIUS7+MOVE7)*SIN(TT*YCYCLE7*SIGN7+ROT7)+(RADIUS8+MOVE8)*SIN(TT*YCYCLE8*SIGN8+ROT8) PLOT LINES:X,Y; NEXT TT SET DRAW MODE EXPLICIT IF SAVE=1 THEN LET KK=KK+1 GSAVE "image"&USING$("%%%%%",KK)&".png" PRINT "No.";KK END IF WAIT DELAY .1 SET DRAW MODE HIDDEN NEXT TH LOOP UNTIL SAVE=1 AND TH=>359 END EXTERNAL SUB GINIT(XSIZE,YSIZE) SET BITMAP SIZE XSIZE,YSIZE !'SET WINDOW 0 , XSIZE-1 , YSIZE-1, 0 SET POINT STYLE 1 FOR I=0 TO 7 SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1) NEXT I CLEAR END SUB EXTERNAL SUB LISSAJOUS(X,Y,R,C,N,M,ROT) OPTION ANGLE DEGREES SET LINE COLOR C PLOT LINES FOR T=0 TO 360 LET XX=X+R*COS(N*T) LET YY=Y+R*SIN(M*T+ROT) PLOT LINES:XX,YY; NEXT T PLOT LINES END SUB

戻る

十進BASIC 第2掲示板 過去ログ

十進BASIC 第2掲示板過去ログ