十進BASIC 第3掲示板

十進BASIC第3掲示板

十進BASICプログラミングについての質問や研究成果の公開にご利用ください。
メッセージ入力枠は右下をドラッグして拡大できます。 画像,URLは省略可能です。
編集/削除キーを入力しなくてもエラーにはなりませんが,何か適当な半角英数字4~8文字を指定してください。
特に,長文投稿の場合,プレビューで最後の行を確認しても,実際には途中で切れてしまうことがあるので,投稿後の確認が必要です。

オセロゲーム - しばっち

2025/05/05 (Mon) 07:41:03

オセロゲームの移植版です。

キー入力による操作です。マウスは使用しません。


DECLARE EXTERNAL FUNCTION INKEY$
DECLARE EXTERNAL FUNCTION INPUT$
10 DIM V(8,8),N$(2),P(10),M(10)
CALL GINIT(640,400)
CALL GCOLOR(7)
40 CLEAR
GOSUB 660
50 CALL BOXFULL(0,0,639,399,4)
CALL BOXFULL(10,10,190*2,190*2,6)
FOR A=0 TO 7
FOR B=0 TO 7
60 CALL BOX(15+(A*20+10)*2,10+(B*20+10)*2,15+(A*20+30)*2,10+(B*20+30)*2,0)
NEXT B
NEXT A
70 CALL GPRINT(6,0,"1")
CALL GPRINT(11,0,"2")
CALL GPRINT(16,0,"3")
CALL GPRINT(21,0,"4")
CALL GPRINT(26,0,"5")
CALL GPRINT(31,0,"6")
CALL GPRINT(36,0,"7")
CALL GPRINT(41,0,"8")
CALL GPRINT(48,0,"--- COMPUTER OTHELLO ---")
80 FOR A=1 TO 8
CALL GPRINT(0,A*2.5+1,CHR$(48+A))
NEXT A
90 RESTORE 100
FOR A=1 TO 4
READ X,Y,CO
GOSUB 630
LET V(X,Y)=CO+1
NEXT A
100 DATA 4,4,7,5,4,0,4,5,0,5,5,7
110 CALL GPRINT(54,2,"先手(黒) ")
CALL GPRINT(54,4,"後手(白) ")
120 CALL GPRINT(52,6," --- 順番 ---")
130 CALL GPRINT(51,8,"対戦(0) / 先手(1) / 後手(2)")
DO
LET X$=INKEY$
LOOP WHILE X$=""
140 LET J=VAL(X$)
IF J>2 THEN LET J=2
150 IF J=0 THEN
LET N$(1)="PLAYER-1 "
LET N$(2)="PLAYER-2 "
GOTO 170
END IF
IF J=2 THEN LET JN=J-1 ELSE LET JN=J+1
160 LET N$(J)="PLAYER-1 "
LET N$(JN)="COMPUTER "
170 CALL GPRINT(63,2,N$(1))
CALL GPRINT(63,4,N$(2))
180 CALL GPRINT(52,6,"--- キー入力 ---")
CALL GPRINT(55,15,"--- パス ---")
190 CALL GPRINT(51,8," [E] 終了 ")
CALL GPRINT(54,17,N$(1)&" "&STR$(P(1)))
200 CALL GPRINT(54,9,"[P] パス")
LET E=0
CALL GPRINT(54,19,N$(2)&" "&STR$(P(2)))
210 IF E=60 THEN
GOTO 540
ELSE
LET F=1
GOTO 300
END IF
220 LET CO=0
LET K=8
IF J+1=1 OR J+1=2 THEN GOSUB 250
IF J+1=3 THEN GOSUB 380
IF KK=0 THEN
GOTO 210
ELSE
LET E=E+1
END IF
230 IF E=60 THEN
GOTO 540
ELSE
LET F=2
GOTO 300
END IF
240 LET CO=7
LET K=1
IF J+1=1 OR J+1=3 THEN GOSUB 250
IF J+1=2 THEN GOSUB 380
IF KK=0 THEN
GOTO 230
ELSE
LET E=E+1
GOTO 210
END IF
250 LET KX=X
LET KY=Y
FOR AX=-1 TO 1
FOR AY=-1 TO 1
IF AX=0 AND AY=0 THEN CALL GCOLOR(0) ELSE LET N=2
260 LET A=KX+AX*N
LET B=KY+AY*N
IF A<1 OR A>8 OR B<1 OR B>8 OR KX+AX>8 OR KX+AX<1 OR KY+AY<1 OR KY+AY>8 THEN
GOTO 290
ELSE
IF V(KX+AX*(N-1),KY+AY*(N-1))<>K THEN 290
END IF
270 IF V(A,B)<>CO+1 THEN
LET N=N+1
GOTO 260
ELSE
LET CO=CO
LET KK=1
END IF
280 FOR I=0 TO N
LET X=KX+AX*I
LET Y=KY+AY*I
GOSUB 630
LET V(X,Y)=CO+1
NEXT I
LET X=KX
LET Y=KY
GOSUB 630
290 NEXT AY
NEXT AX
RETURN
300 FOR Z=0 TO 5
NEXT Z
CALL GPRINT(52,11,N$(F)&"の番です。 ")
LET KK=0
CALL GPRINT(55,13," ")
310 IF J+F=3 THEN 370
320 FOR Z=0 TO 5
NEXT Z
CALL GPRINT(55,13," ")
CALL GPRINT(55,13,"横=")
DO
LET X$=INKEY$
LOOP WHILE X$=""
CALL GPRINT(59,13,X$)
FOR Z=0 TO 1500
NEXT Z
330 IF X$="E" OR X$="e" THEN
GOTO 540
ELSE
IF X$="P" OR X$="p" THEN 490
END IF
340 LET X=VAL(X$)
IF X=0 OR X=9 THEN 320
350 CALL GPRINT(64,13," ")
CALL GPRINT(64,13,"縦=")
DO
LET X$=INKEY$
LOOP WHILE X$=""
LET Y=VAL(X$)
CALL GPRINT(68,13,STR$(Y))
360 IF Y=0 OR Y=9 THEN
GOTO 350
ELSE
IF V(X,Y)<>0 THEN 320
END IF
370 IF F=1 THEN 220
IF F=2 THEN 240
380 RESTORE 430
390 READ X,Y
IF X=9 THEN 490
400 IF V(X,Y)<>0 THEN 390
IF JN=2 THEN LET CO=7 ELSE LET CO=0
410 GOSUB 250
420 IF KK=0 THEN
GOTO 390
ELSE
RETURN
END IF
430 DATA 1,8,8,1,1,1,8,8,3,3,6,3,3,6,6,6,1,6,8,3
440 DATA 3,1,6,8,8,6,1,3,6,1,3,8,2,6,2,3,3,2,6,2
450 DATA 7,3,7,6,3,7,6,7,4,3,5,6,3,4,6,5,3,5,5,3
460 DATA 4,6,6,4,4,7,5,7,4,2,7,5,2,4,2,5,7,4,1,5
470 DATA 4,1,5,2,5,8,8,5,4,8,1,4,5,1,8,4,2,2,7,1
480 DATA 7,8,2,7,1,2,7,2,8,7,1,7,2,1,8,2,2,8,7,7,9,0
490 CALL GPRINT(54,13,N$(F)&" パス ")
FOR Z=0 TO 2000
NEXT Z
500 LET P(F)=P(F)+1
IF P(F)=3 THEN 540
510 FOR I=0 TO 1000
NEXT I
CALL GPRINT(54,2*F+15,N$(F)&" "&STR$(P(F)))
520 CALL GPRINT(54,13,REPEAT$(" ",18))
IF J+F=3 THEN
LET E=E-1
LET KK=1
RETURN
END IF
IF F=1 THEN 230
IF F=2 THEN 210
540 CALL GCOLOR(2)
CALL GPRINT(53,15,"-- GAME END --")
CALL GCOLOR(0)
550 FOR A=1 TO 8
FOR B=1 TO 8
LET M(V(A,B))=M(V(A,B))+1
NEXT B
NEXT A
560 CALL GPRINT(54,17,N$(1)&" "&STR$(M(1)))
570 CALL GPRINT(54,19,N$(2)&" "&STR$(M(8)))
580 LET SS=ABS(M(1)-M(8))
IF M(1)>M(8) THEN LET F=1 ELSE LET F=2
590 IF SS>0 THEN CALL GPRINT(52,11,N$(F)&"の勝ちです ") ELSE CALL GPRINT(52,11,"ひきわけです ")
600 CALL GPRINT(52,13,"HIT [RETURN] KEY")
610 LET A$=INPUT$(1)
IF A$=CHR$(13) THEN 40 ELSE 600
630 CALL CIRCLEFULL(X*20*2+15,Y*20*2+10,15,CO)
640 RETURN
660 FOR C=1 TO 7
670 CALL GCOLOR(C)
CALL GPRINT(27,5,"COMPUTER OTHELLO")
680 CALL GCOLOR(C-1)
CALL GPRINT(25,18,"PUSH [SPACE] KEY TO START!")
690 LET I$=INKEY$
700 IF I$=" " THEN RETURN
710 NEXT C
GOTO 660
END

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"
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
CLEAR
SET TEXT JUSTIFY "LEFT","TOP"
SET TEXT FONT "MS ゴシック",0
SET TEXT HEIGHT 12
END SUB

EXTERNAL SUB GPRINT(X,Y,A$)
FOR I=1 TO LEN(A$)
LET AA$=MID$(A$,I,1)
ASK TEXT COLOR C
ASK PIXEL VALUE(XX+INT(X)*8,INT(Y)*16) CC
IF BLEN(AA$)<>LEN(AA$) THEN
CALL BOXFULL(XX+INT(X)*8,INT(Y)*16,XX+INT(X)*8+15,INT(Y)*16+15,CC)
ELSE
CALL BOXFULL(XX+INT(X)*8,INT(Y)*16,XX+INT(X)*8+7,INT(Y)*16+15,CC)
END IF
SET COLOR C
PLOT TEXT,AT XX+INT(X)*8,INT(Y)*16:AA$
IF BLEN(AA$)<>LEN(AA$) THEN LET XX=XX+16 ELSE LET XX=XX+8
NEXT I
END SUB

EXTERNAL SUB GCOLOR(C)
SET TEXT COLOR C
END SUB

EXTERNAL SUB LINE(XS,YS,XE,YE,C)
SET COLOR C
PLOT LINES
PLOT LINES:XS,YS;XE,YE
END SUB

EXTERNAL SUB BOXFULL(X1,Y1,X2,Y2,C)
SET COLOR C
PLOT AREA:X1,Y1;X2,Y1;X2,Y2;X1,Y2;X1,Y1
END SUB

EXTERNAL SUB CIRCLEFULL(X,Y,RR,C)
SET COLOR C
DRAW DISK WITH SCALE(RR)*SHIFT(X,Y)
END SUB

EXTERNAL FUNCTION INKEY$
SET ECHO "OFF"
LET S$=""
CHARACTER INPUT NOWAIT:S$
LET INKEY$=S$
END FUNCTION

EXTERNAL FUNCTION INPUT$(N)
SET ECHO "OFF"
FOR I=1 TO N
DO
LET X$=""
CHARACTER INPUT NOWAIT:X$
LOOP WHILE X$=""
LET S$=S$&X$
NEXT I
LET INPUT$=S$
END FUNCTION

EXTERNAL SUB BOX(XS,YS,XE,YE,C)
CALL LINE(XS,YS,XE,YS,C)
CALL LINE(XE,YS,XE,YE,C)
CALL LINE(XE,YE,XS,YE,C)
CALL LINE(XS,YE,XS,YS,C)
END SUB

名前
件名
メッセージ
画像
メールアドレス
URL
編集/削除キー (半角英数字のみで4~8文字)
プレビューする (投稿前に、内容をプレビューして確認できます)

Copyright © 1999- FC2, inc All Rights Reserved.