OCamlでオセロ。2013年度前期の大学の課題。

othello.ml

(* $ ocamlc graphics.cma ./othello.mlでコンパイル *)
open Graphics;;
Graphics.open_graph "";;
Graphics.set_window_title "Othello";;
Graphics.resize_window 500 401;;

(* 盤面を塗りつぶす *)
Graphics.set_color (Graphics.rgb 0 200 0);;
Graphics.fill_rect 0 0 400 400;;

(* 線を引く *)
Graphics.set_color (Graphics.rgb 0 0 0);;
for i = 0 to 8 do 
	Graphics.moveto (50*i) 0;
	Graphics.lineto (50*i) 400;
	Graphics.moveto 0 (50*i);
	Graphics.lineto 400 (50*i);
done;

(* 石が今何色かを判断するための型 *)
type disk =
	| BLACK
	| WHITE
	| NULL;;

(* judge関数で用いる型 *)
type consider =
	| UP
	| DOWN
	| RIGHT
	| LEFT
	| UPPER_RIGHT
	| UPPER_LEFT
	| DOWNER_RIGHT
	| DOWNER_LEFT;;

(* 石の数を記憶するための変数 *)
let n = ref 0;;
(* 現在の石の色を記憶するための変数 *)
let is_white = ref true;;
(* 位置を記憶するための配列 *)
let positions = ref [|(Array.make 8 NULL);(Array.make 8 NULL);(Array.make 8 NULL);(Array.make 8 NULL);(Array.make 8 NULL);(Array.make 8 NULL);(Array.make 8 NULL);(Array.make 8 NULL)|];;

(* 石を描く関数 nの値によって描く色を変える *)
let draw_disk x y =
	if !is_white then begin
		Graphics.set_color (Graphics.rgb 255 255 255);
		!positions.(x).(y) <-WHITE
	end
	else begin
		Graphics.set_color (Graphics.rgb 0 0 0);
		!positions.(x).(y) <-BLACK
	end;
	Graphics.fill_circle (x*50+25) (y*50+25) 25;
	Graphics.set_color (Graphics.rgb 0 0 0);
	Graphics.draw_circle (x*50+25) (y*50+25) 25;;

(* 最初の4つの石を描く *)
draw_disk 3 3;;
draw_disk 4 4;;
is_white := false;;
draw_disk 3 4;;
draw_disk 4 3;;
n:=4;;

(* 右方向に石を反転させるための関数 *)
let rec return_disks_x x y rest = 
	if rest!=0 then (
		draw_disk x y;
		return_disks_x (x+1) y (rest-1));;

(* 上方向に石を反転させるための関数 *)
let rec return_disks_y x y rest =
	if rest!=0 then (
		draw_disk x y;
		return_disks_y x (y+1) (rest-1));;

(* 斜め右上方向に石を反転させるための関数 *)
let rec return_disks_obliquely_r x y rest =
	if rest!=0 then (
		draw_disk x y;
		return_disks_obliquely_r (x+1) (y+1) (rest-1));;

(* 斜め左上方向に石を反転させるための関数 *)
let rec return_disks_obliquely_l x y rest =
	if rest!=0 then (
		draw_disk x y;
		return_disks_obliquely_l (x-1) (y+1) (rest-1));;

(* 石が置けるかどうかを判定し、置ける場合は置くための関数 *)
let rec judge x y count list return =
	let new_list = ref [] and
		color = if !is_white then WHITE else BLACK and
		other_color = if !is_white then BLACK else WHITE and
		returned = ref false in

		(* もしもlist(考慮する方向)にUPが含まれていた場合 *)
		if List.exists (fun a -> a=UP) list && y+count<8 then begin
			(* カウントが1ではなく、色が現在の色と同じ場合、その手前までをひっくり返す *)
			if !positions.(x).(y+count) = color && count!=1 then (
				if return then return_disks_y x (y+1) (count-1);
				returned := true)
			(* 色が現在の色ではない方の場合、考慮を続ける *)
			else if !positions.(x).(y+count) = other_color then
				new_list := UP :: !new_list
		end;

		(* 以下同様 *)
		if List.exists (fun a -> a=DOWN) list && y-count>=0 then begin
			if !positions.(x).(y-count) = color && count!=1 then (
				if return then return_disks_y x (y-count+1) (count-1);
				returned := true)
			else if !positions.(x).(y-count) = other_color then
				new_list := DOWN :: !new_list
		end;
		if List.exists (fun a -> a=RIGHT) list && x+count<8 then begin
			if !positions.(x+count).(y) = color && count!=1 then (
				if return then return_disks_x (x+1) y (count-1);
				returned := true)
			else if !positions.(x+count).(y) = other_color then
				new_list := RIGHT :: !new_list
		end;
		if List.exists (fun a -> a=LEFT) list && x-count>=0 then begin
			if !positions.(x-count).(y) = color && count!=1 then (
				if return then return_disks_x (x-count+1) y (count-1);
				returned := true)
			else if !positions.(x-count).(y) = other_color then
				new_list := LEFT :: !new_list
		end;
		if List.exists (fun a -> a=UPPER_RIGHT) list && y+count<8 && x+count<8 then begin
			if !positions.(x+count).(y+count) = color && count!=1 then (
				if return then return_disks_obliquely_r (x+1) (y+1) (count-1);
				returned := true)
			else if !positions.(x+count).(y+count) = other_color then
				new_list := UPPER_RIGHT :: !new_list
		end;
		if List.exists (fun a -> a=UPPER_LEFT) list && y+count<8 && x-count>=0 then begin
			if !positions.(x-count).(y+count) = color && count!=1 then (
				if return then return_disks_obliquely_l (x-1) (y+1) (count-1);
				returned := true)
			else if !positions.(x-count).(y+count) = other_color then
				new_list := UPPER_LEFT :: !new_list
		end;
		if List.exists (fun a -> a=DOWNER_RIGHT) list && y-count>=0 && x+count<8 then begin
			if !positions.(x+count).(y-count) = color && count!=1 then (
				if return then return_disks_obliquely_l (x+count-1) (y-count+1) (count-1);
				returned := true)
			else if !positions.(x+count).(y-count) = other_color then
				new_list := DOWNER_RIGHT :: !new_list
		end;
		if List.exists (fun a -> a=DOWNER_LEFT) list && y-count>=0 && x-count>=0 then begin
			if !positions.(x-count).(y-count) = color && count!=1 then (
				if return then return_disks_obliquely_r (x-count+1) (y-count+1) (count-1);
				returned := true;)
			else if !positions.(x-count).(y-count) = other_color then
				new_list := DOWNER_LEFT :: !new_list
		end;
		(* 次に考慮するものがない場合、一度でもひっくり返したかどうかを返す *)
		if !new_list=[] then !returned
		else begin
			returned := ((judge x y (count+1) !new_list return) || !returned);
			!returned
		end;;

(* クリックした位置がNULLかどうか *)
let position_is_null x y = (!positions.(x).(y) = NULL);;

(* 置くところがあるかどうか調べる *)
let rec search x y =
	if (not (position_is_null x y && judge x y 1 [UP;DOWN;RIGHT;LEFT;UPPER_RIGHT;UPPER_LEFT;DOWNER_RIGHT;DOWNER_LEFT] false)) then
		if x=7 && y=7 then
			false
		else if x=7 then
			search 0 (y+1)
		else search (x+1) y
	else true;;
(* 数を数える *)
let rec count_score t x y score =
	if !positions.(x).(y) = t then
		if x=7 && y=7 then score+1
		else if x=7 then
			count_score t 0 (y+1) (score+1)
		else count_score t (x+1) y (score+1)
	else
		if x=7 && y=7 then score
		else if x=7 then
			count_score t 0 (y+1) score
		else count_score t (x+1) y score;;

(* スコアを表示する *)
let update_score () =
	Graphics.moveto 420 40;
	Graphics.set_color (Graphics.rgb 255 255 255);
	Graphics.fill_rect 401 0 600 401;
	Graphics.set_color (Graphics.rgb 0 0 0);
	Graphics.draw_string ("Black:"^string_of_int (count_score BLACK 0 0 0));
	Graphics.moveto 420 20;
	Graphics.draw_string ("White:"^string_of_int (count_score WHITE 0 0 0));;

(* 現在のプレイヤーを表示 *)
let current_player () =
	Graphics.moveto 420 60;
	Graphics.set_color (Graphics.rgb 0 0 0);
	Graphics.draw_string ("Current:");
	Graphics.draw_circle 480 65 5;
	if not !is_white then Graphics.fill_circle 480 65 5;;

(* 勝者を表示 *)
let show_winner () =
	Graphics.moveto 420 220;
	Graphics.set_color (Graphics.rgb 200 0 0);
	Graphics.draw_string ((if count_score WHITE 0 0 0 > count_score BLACK 0 0 0 then "White" else "Black")^" wins!");;

(* 石が64個置かれるまではゲームを続ける 64個置き終わったら、次にクリックした時にウィンドウを消す *)
update_score ();
current_player();;
while !n<=64 do
	let st = Graphics.wait_next_event [Button_down] in
		if !n=64 then n:=65
		else if st.mouse_x<=400 && st.mouse_y<=400 then begin
			if position_is_null (st.mouse_x/50) (st.mouse_y/50) then (
				if judge (st.mouse_x/50) (st.mouse_y/50) 1 [UP;DOWN;RIGHT;LEFT;UPPER_RIGHT;UPPER_LEFT;DOWNER_RIGHT;DOWNER_LEFT] true then (
					draw_disk (st.mouse_x/50) (st.mouse_y/50);
					n := !n+1;
					update_score ();
					is_white := (not !is_white);
					if not (search 0 0) then (
						is_white := (not !is_white);
						if not (search 0 0) then n:=64
					);
					if !n=64 then show_winner () else current_player()
				)
			);
		end
done;;
Graphics.close_graph ();;