DynamicModule[{board,turn,directions,isInside,findFlips,flipStones,makeMove,resetGame,countBlack,countWhite,hasMoveQ,checkGameEnd,message="",penalties=<|1->0,-1->0|>,gameOver=False},(*初期化関数*)resetGame[]:=(board=ConstantArray[0,{8,8}];
board[[4,4]]=board[[5,5]]=-1;
board[[4,5]]=board[[5,4]]=1;
turn=1;
message="";
penalties=<|1->0,-1->0|>;
gameOver=False;);
resetGame[];
directions={{1,0},{-1,0},{0,1},{0,-1},{1,1},{-1,-1},{1,-1},{-1,1}};
isInside[{x_,y_}]:=1<=x<=8&&1<=y<=8;
findFlips[{x_,y_},color_]:=Module[{toFlip={},dx,dy,nx,ny,path},If[board[[y,x]]!=0,Return[{}]];
Do[{dx,dy}=dir;
nx=x+dx;ny=y+dy;path={};
While[isInside[{nx,ny}]&&board[[ny,nx]]==-color,AppendTo[path,{nx,ny}];
nx+=dx;ny+=dy;];
If[isInside[{nx,ny}]&&board[[ny,nx]]==color&&Length[path]>0,toFlip=Join[toFlip,path];],{dir,directions}];
toFlip];
flipStones[flips_,color_]:=(Do[board[[pos[[2]],pos[[1]]]]=color,{pos,flips}]);
hasMoveQ[color_]:=Length@Select[Flatten[Table[{x,y},{x,1,8},{y,1,8}],1],findFlips[#,color]=!={}&]>0;
makeMove[{x_,y_}]:=Module[{flips},If[gameOver,Return[]];(* ←ここが重要！*)flips=findFlips[{x,y},turn];
If[flips=!={},board[[y,x]]=turn;
flipStones[flips,turn];
turn*=-1;
If[!hasMoveQ[turn],If[hasMoveQ[-turn],message=If[turn==1,"白がパス","黒がパス"];
turn*=-1;,checkGameEnd[]],message=""];,penalties[turn]+=1;
message=If[turn==1,"黒","白"]<>"が不正手！ペナルティ: "<>ToString[penalties[turn]];
If[penalties[turn]>=3,message=If[turn==1,"黒","白"]<>"が3回の反則で負け！";
gameOver=True; (* ←ここが重要！*)]];];
checkGameEnd[]:=(Module[{b=countBlack[],w=countWhite[]},message="ゲーム終了！ "<>If[b>w,"黒の勝ち",If[w>b,"白の勝ち","引き分け"]]<>"（黒: "<>ToString[b]<>", 白: "<>ToString[w]<>"）";
gameOver=True;]);
countBlack[]:=Count[Flatten[board],1];
countWhite[]:=Count[Flatten[board],-1];
Column[{Row[{"● 黒: ",Dynamic[countBlack[]],Spacer[10],"○ 白: ",Dynamic[countWhite[]],Spacer[10],"⚠️ ペナルティ - 黒: ",Dynamic[penalties[1]]," 白: ",Dynamic[penalties[-1]],Spacer[20],Button["リセット",resetGame[],ImageSize->Medium]}],Dynamic@Style[message,Red,14],EventHandler[Dynamic@Graphics[Table[{EdgeForm[Black],FaceForm[RGBColor[0,0.5,0]],Rectangle[{x-1,y-1},{x,y}],Which[board[[y,x]]==1,{Black,Disk[{x-0.5,y-0.5},0.4]},board[[y,x]]==-1,{White,Disk[{x-0.5,y-0.5},0.4]},True,Nothing]},{x,1,8},{y,1,8}],PlotRange->{{0,8},{0,8}},ImageSize->400,Axes->False],{"MouseDown":>Module[{pos,x,y},pos=MousePosition["Graphics"];
If[ListQ[pos]&&!gameOver,{x,y}=Floor[pos]+1;
If[1<=x<=8&&1<=y<=8,makeMove[{x,y}]];];]}]}]]