十進BASICプログラミングについての質問や研究成果の公開にご利用ください。
メッセージ入力枠は右下をドラッグして拡大できます。 画像，URLは省略可能です。
編集/削除キーを入力しなくてもエラーにはなりませんが，何か適当な半角英数字4～8文字を指定してください。
特に，長文投稿の場合，プレビューで最後の行を確認しても，実際には途中で切れてしまうことがあるので，投稿後の確認が必要です。
もぐらたたきゲーム
- しばっち
2025/07/13 (Sun) 07:33:12
テンキー用もぐらたたきゲームです。
ミス４回でゲームオーバーになります。
DECLARE EXTERNAL FUNCTION STICK
DIM XX(9),YY(9),XS(9),YS(9),A$(9)
SET TEXT JUSTIFY "CENTER","HALF"
SET TEXT COLOR 1
SET TEXT HEIGHT .1
RANDOMIZE
LET TI=3
SET TEXT COLOR 1
SET TEXT HEIGHT .08
SET TEXT BACKGROUND "OPAQUE"
PLOT TEXT ,AT .5,.5:"HIT ANY KEY"
DO
FOR I=13 TO 127
IF GETKEYSTATE(I)<0 THEN EXIT DO
NEXT I
LOOP
CLEAR
FOR Y=.15 TO .9 STEP .3
FOR X=1/6 TO 1 STEP 1/3
LET N=N+1
READ A$(N)
PLOT TEXT ,AT X,Y:A$(N)
LET XS(N)=X
LET YS(N)=Y
NEXT X
NEXT Y
DATA 1,2,3,4,5,6,7,8,9
!DATA Z,X,C,A,S,D,Q,W,E
!DATA J,K,L,U,I,O,7,8,9
LET N=0
FOR Y=1 TO 3
FOR X=0 TO 2
LET N=N+1
LET XX(N)=X/3
LET YY(N)=Y*.3
NEXT X
NEXT Y
DO ! ゲームスタート
LET N=INT(RND*9+1)
CALL BOX(XX(N),YY(N),XX(N)+1/3,YY(N)-.3,2)
SET TEXT COLOR 3
SET TEXT HEIGHT .1
SET TEXT BACKGROUND "TRANSPARENT"
PLOT TEXT ,AT XS(N),YS(N):A$(N)
SET LINE COLOR 4
FOR Y=1 TO 3
PLOT LINES:0,Y*.3;1,Y*.3
NEXT Y
FOR X=1 TO 2
PLOT LINES:X/3,0;X/3,1
NEXT X
LET T=TIME
LET FL=0
DO
SET TEXT COLOR 1
SET TEXT HEIGHT .08
SET TEXT BACKGROUND "OPAQUE"
PLOT TEXT ,AT .5,.95:"SCORE:"&STR$(SCORE)&" MISS:"&STR$(MISS)
LET S=STICK
IF S=N THEN
CALL BOX(XX(N),YY(N),XX(N)+1/3,YY(N)-.3,4)
LET SCORE=SCORE+1
LET TI=TI-.1
IF TI<.3 THEN LET TI=.3
DO
LOOP WHILE STICK<>0
EXIT DO
ELSEIF S<>0 AND S<>N THEN
LET MISS=MISS+1
LET FL=1
DO
LOOP WHILE STICK<>0
EXIT DO
END IF
LOOP WHILE TIME-T<=TI
IF FL=0 AND S<>N THEN LET MISS=MISS+1
CALL BOX(XX(N),YY(N),XX(N)+1/3,YY(N)-.3,0)
SET TEXT COLOR 1
SET TEXT HEIGHT .1
SET TEXT BACKGROUND "TRANSPARENT"
PLOT TEXT ,AT XS(N),YS(N):A$(N)
LOOP UNTIL MISS=>4
SET TEXT COLOR 4
SET TEXT BACKGROUND "OPAQUE"
SET TEXT HEIGHT .15
PLOT TEXT ,AT .5,.45:"GAME OVER"
END
EXTERNAL SUB BOX(X1,Y1,X2,Y2,C)
SET AREA COLOR C
PLOT AREA:X1,Y1;X2,Y1;X2,Y2;X1,Y2
END SUB
EXTERNAL FUNCTION STICK
LET STICK=0
FOR I=97 TO 105
IF GETKEYSTATE(I)<0 THEN
LET STICK=I-96
EXIT FUNCTION
END IF
NEXT I
RESTORE
DATA Z,X,C,A,S,D,Q,W,E
!DATA J,K,L,U,I,O,7,8,9
FOR I=1 TO 9
READ A$
IF GETKEYSTATE(ORD(A$))<0 OR GETKEYSTATE(ORD(LCASE$(A$)))<0 THEN LET STICK=I
NEXT I
END FUNCTION
Re: もぐらたたきゲーム
- しばっち
2025/07/13 (Sun) 07:35:22
キーボード用もぐらたたきゲーム
主に数字キーやアルファベットキーを使ったもぐらたたきです。
シフトキーやコントロールキーやAltキー等は使用しません。
DECLARE EXTERNAL FUNCTION STICK
DIM XS(100),YS(100),XE(100),YE(100),A$(50),K(127)
CALL GINIT(1200,900)
SET TEXT JUSTIFY "CENTER","HALF"
SET TEXT HEIGHT 40
RANDOMIZE
LET TI=3
SET TEXT COLOR 7
SET TEXT BACKGROUND "OPAQUE"
PLOT TEXT ,AT 600,400:"HIT ANY KEY"
CHARACTER INPUT P$
CLEAR
LET Y=100
FOR X=0 TO 1199 STEP 1200/13
LET N=N+1
LET XS(N)=X
LET YS(N)=Y
LET XE(N)=X+1200/13
LET YE(N)=Y+200
NEXT X
LET Y=300
FOR X=0 TO 1199 STEP 100
LET N=N+1
LET XS(N)=X
LET YS(N)=Y
LET XE(N)=X+100
LET YE(N)=Y+200
NEXT X
LET Y=500
FOR X=0 TO 1199 STEP 100
LET N=N+1
LET XS(N)=X
LET YS(N)=Y
LET XE(N)=X+100
LET YE(N)=Y+200
NEXT X
LET Y=700
FOR X=0 TO 1199 STEP 1200/11
LET N=N+1
LET XS(N)=X
LET YS(N)=Y
LET XE(N)=X+1200/11
LET YE(N)=Y+200
NEXT X
FOR I=1 TO N-1
READ A$(I)
CALL BOX(XS(I),YS(I),XE(I),YE(I),7)
PLOT TEXT ,AT (XS(I)+XE(I))/2,(YS(I)+YE(I))/2:A$(I)
LET K(ORD(A$(I)))=I
LET K(ORD(LCASE$(A$(I))))=I
NEXT I
DATA "1","2","3","4","5","6","7","8","9","0","-","^","\"
DATA "Q","W","E","R","T","Y","U","I","O","P","@","["
DATA "A","S","D","F","G","H","J","K","L",";",":","]"
DATA "Z","X","C","V","B","N","M",",",".","/",""
DO ! ゲームスタート
LET NN=INT(RND*(N-1)+1)
CALL BOXFULL(XS(NN),YS(NN),XE(NN),YE(NN),1)
SET TEXT COLOR 4
SET TEXT HEIGHT 40
SET TEXT BACKGROUND "TRANSPARENT"
PLOT TEXT ,AT (XS(NN)+XE(NN))/2,(YS(NN)+YE(NN))/2:A$(NN)
LET T=TIME
LET FL=0
DO
SET TEXT COLOR 7
SET TEXT HEIGHT 50
SET TEXT BACKGROUND "OPAQUE"
PLOT TEXT ,AT 600,50:"SCORE:"&STR$(SCORE)&" MISS:"&STR$(MISS)
CHARACTER INPUT NOWAIT:S$
IF S$<>"" AND NN=K(ORD(S$)) THEN
CALL BOXFULL(XS(NN),YS(NN),XE(NN),YE(NN),2)
WAIT DELAY .1
LET SCORE=SCORE+1
LET TI=TI-.1
IF TI<.3 THEN LET TI=.3
LET S$=""
DO
CHARACTER INPUT NOWAIT:S$
LOOP WHILE S$<>""
EXIT DO
ELSEIF S$<>"" AND K(ORD(S$))<>NN THEN
LET MISS=MISS+1
LET FL=1
LET S$=""
DO
CHARACTER INPUT NOWAIT:S$
LOOP WHILE S$<>""
EXIT DO
END IF
LOOP WHILE TIME-T<=TI
IF FL=0 AND S$<>"" AND K(ORD(S$))<>NN THEN LET MISS=MISS+1
CALL BOXFULL(XS(NN),YS(NN),XE(NN),YE(NN),0)
SET TEXT COLOR 7
SET TEXT HEIGHT 40
SET TEXT BACKGROUND "TRANSPARENT"
PLOT TEXT ,AT (XS(NN)+XE(NN))/2,(YS(NN)+YE(NN))/2:A$(NN)
CALL BOX(XS(NN),YS(NN),XE(NN),YE(NN),7)
LOOP UNTIL MISS=>4
SET TEXT COLOR 2
SET TEXT BACKGROUND "OPAQUE"
SET TEXT HEIGHT 150
PLOT TEXT ,AT 600,450:"GAME OVER !!"
END
EXTERNAL SUB BOXFULL(X1,Y1,X2,Y2,C)
SET AREA COLOR C
PLOT AREA:X1,Y1;X2,Y1;X2,Y2;X1,Y2
END SUB
EXTERNAL SUB BOX(XS,YS,XE,YE,C)
SET LINE COLOR C
PLOT LINES:XS,YS;XE,YS
PLOT LINES:XE,YS;XE,YE
PLOT LINES:XE,YE;XS,YE
PLOT LINES:XS,YE;XS,YS
END SUB
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