unit Game_GUI;
// Unité gérant l'interface graphique et le fonctionnement du jeu principal

interface

uses ai, crt, gLib2D, sdl_addon, sdl, sdl_ttf, sysutils;

function hlSouris(x,y : integer):integer;
procedure load(var m,mCol : matrix ; var size : coord ; n : integer ; var multi, turn, first : integer);
procedure game(var m,mCol : matrix ; size : coord ; font : pttf_font ; multi, fond, turn, first : integer ; var win1 : integer);
procedure blitText(x,y : integer ; image : gImage ; color : gColor);
procedure blit(alpha,x,y,w,h : integer ; image : gImage ; coordMode : integer);
procedure catSaveDisp(var bd,save1,save2,save3,retour : gimage ; font : pttf_font ; hl : integer);
function colorText(hlGame, file_is_there : boolean):gColor;
procedure initchangementFond(fond:integer;var bd,titre: gimage);
procedure changementFond(fond : integer; var bd : gimage);

implementation

procedure init(bd,titre : gimage);
// RODRIGUEZ Sébastien
// Procédure blitant le fond d'écran et le gros titre
begin
	gBeginRects(bd);
		gSetCoordMode(G_UP_LEFT);
		gSetAlpha(130);
		gSetScaleWH(800,600);
		gSetCoord(0,0);
		gAdd;
	gEnd;
	blitText(G_SCR_W div 2,120,titre,white);
end;

procedure changementFond(fond : integer; var bd : gimage);
// RODRIGUEZ Sébastien
// Initialisation du fond d'écran, selon les paramètres définis dans le menu paramètre
begin
	case fond of
	0: 	bd := gTexLoad('greybrick.jpg');
	1: 	bd := gTexLoad('redbrick.jpg');
	2: 	bd := gTexLoad('greenbrick.jpg');
	3: 	bd := gTexLoad('bluebrick.jpg');
	end;
end;

procedure initchangementFond(fond:integer;var bd,titre: gimage);
// RODRIGUEZ Sébastien
// Regroupement des initialisations du fond d'écran et du gros titre
begin
		changementFond(fond,bd);
		init(bd,titre);
end;

procedure blit(alpha,x,y,w,h : integer ; image : gImage ; coordMode : integer);
// RODRIGUEZ Sébastien
// Procédure permettant de bliter une image (ie. charger cette image pour pouvoir la retourner par la suite)
begin
	gBeginRects(image);
		gSetAlpha(alpha);
		gSetCoordMode(coordMode);
		gSetScaleWH(w,h);
		gSetCoord(x,y);
		gAdd;
	gEnd;
end;

procedure blitText(x,y : integer ; image : gImage ; color : gColor);
// RODRIGUEZ Sébastien
// Blit d'un texte
begin
	gBeginRects(image);
		gSetAlpha(200);
		gSetCoordMode(g_center);
		gSetCoord(x,y);
		gSetColor(color);
		gAdd;
	gEnd;
end;

procedure resetPossible(var mCol : matrix ; size, pos : coord ; player : integer);
// INGOUFF Christian
// Remise à zéro de la mise en évidence du pion sélectionné et des coups possibles
var
	tmpy : integer;
begin
	if player = 1 then tmpy := pos.y-1 else tmpy := pos.y+1;
	if pos.x > 0 then
		mCol[pos.x-1,tmpy] := (pos.x-1+tmpy) mod 2;
	mCol[pos.x,tmpy] := (pos.x+tmpy) mod 2;
	if pos.x < size.x-1 then
		mCol[pos.x+1,tmpy] := (pos.x+1+tmpy) mod 2;
end;

procedure hlPossible(m : matrix ; var mCol : matrix ; size, pos : coord ; player : integer ; var any : boolean);
// INGOUFF Christian
// Mise en évidence du pion sélectionné et des coups possibles
var
	tmpy : integer;
begin
	any := FALSE;
	if player = 1 then tmpy := pos.y-1 else tmpy := pos.y+1;
	if pos.x > 0 then
		if m[pos.x-1,tmpy] <> player then
		begin
			any := TRUE;
			if m[pos.x-1,tmpy] = 0 then
				mCol[pos.x-1,tmpy] := 2
			else
				mCol[pos.x-1,tmpy] := 3;
		end;
	if m[pos.x,tmpy] = 0 then
	begin
		any := TRUE;
		mCol[pos.x,tmpy] := 2;
	end;
	if pos.x < size.x-1 then
		if m[pos.x+1,tmpy] <> player then
		begin
			any := TRUE;
			if m[pos.x+1,tmpy] = 0 then
				mCol[pos.x+1,tmpy] := 2
			else
				mCol[pos.x+1,tmpy] := 3;
		end;
end;

function colorPawn(pawn : integer):gColor;
// INGOUFF Christian
// Fonction déterminant la couleur d'un pion en fonction de sa valeur (1 = joueur blanc, 2 = joueur noir, 3 = rouge)
begin
	case pawn of
		1 : colorPawn := litegray;
		2 : colorPawn := brown;
		3 : colorPawn := red;
	end;
end;

function colorText(hlGame, file_is_there : boolean):gColor;
// INGOUFF Christian
// Fonction déterminant la couleur d'un texte. Rouge si la souris est par dessus le texte (hlGame), vert s'il existe une sauvegarde (dans le cadre du menu sauvegarde/chargement), blanc sinon.
begin
	if hlGame then
		colorText := redbis
	else if file_is_there then
		colorText := green
	else
		colorText := white;
end;

function whoFirstColor(val, first : integer):integer;
// INGOUFF Christian
// Fonction permettant d'inverser la couleur des pions si l'ordinateur vient à posséder les blancs (first = 2), ce qui revient à "tourner" le plateau
begin
	if val = 3 then
		whoFirstColor := 3
	else
		if first = 1 then
			whoFirstColor := val
		else
			whoFirstColor := switch(val);
end;

function sizeFrame(size : coord) : integer;
// INGOUFF Christian
// Fonction déterminant la taille des cases affichées selon la taille de la grille définie dans les paramètres
begin
	case size.x of
		5 : sizeFrame := 100;
		8 : sizeFrame := 64;
		10 : sizeFrame := 50;
		12 : sizeFrame := 42;
	end;
end;

procedure display(m,mCol : matrix ; size : coord ; first, player, fond : integer ; font : PTTF_font ; hlGame : integer);
// INGOUFF Christian
// Procédure gérant l'ensemble de l'affichage du jeu
var
	i,j,szFrame : integer;
	frames : array of gImage;
	bd,sauv,quit : gImage;
begin
	gClear(black);
	szFrame := sizeFrame(size);
	sauv := gTextLoad('SAUVEGARDE',font);
	quit := gTextLoad('QUITTER',font);
	changementFond(fond,bd);
	blit(130,0,0,g_scr_w,g_scr_h,bd,g_up_left);
	setLength(frames,4);
	for i := 0 to 3 do
		frames[i] := gTexLoad('frame'+inttostr(i)+'.jpg');
	
	blitText(55 + (sauv^.w div 2) + (size.x*szFrame), 20 + ((size.y-1)*szFrame div 2), sauv, colorText(hlGame=1,false));
	blitText(55 + (sauv^.w div 2) + (size.x*szFrame), 20 + ((size.y+1)*szFrame div 2), quit, colorText(hlGame=2,false));
	
	if player = 1 then
		gFillCircle(144 + size.x*szFrame,20+(size.y - 1)*szFrame,32,black)
	else
		gFillCircle(144 + size.x*szFrame,20+1*szFrame,32,black);
	
	for j := 0 to size.y-1 do
		for i := 0 to size.x-1 do
		begin
			blit(200,20+i*szFrame,20+j*szFrame,szFrame,szFrame,frames[mCol[i,j]],g_up_left);
			if m[i,j] > 0 then gFillCircle(20+(szFrame div 2)+szFrame*i,20 + (szFrame div 2)+szFrame*j,(szFrame div 2) - 6,colorPawn(whoFirstColor(m[i,j],first)));
		end;
	gFlip;
	
	for i := 0 to 3 do
		gTexFree(frames[i]);
	gTexFree(bd);
	gTexFree(sauv);
end;

procedure eventClick(player : integer ; var m,mCol : matrix ; var tmp : coord ; pos,size : coord ; var mov : integer);
// INGOUFF Christian
// Procédure gérant la modification du plateau si l'utilisateur vient à cliquer sur un pion lui appartenant
var
	any : boolean;
begin
	if (m[pos.x,pos.y] = player) and (mov = 0) then
	begin
		tmp.x := pos.x;
		tmp.y := pos.y;
		hlPossible(m,mCol,size,tmp,player,any);
		if any then
		begin
			m[tmp.x,tmp.y] := 3;
			mov := 1;
		end;
	end
	else if mov = 1 then
	begin
		if mCol[pos.x,pos.y] > 1 then
		begin
			m[tmp.x,tmp.y] := 0;
			m[pos.x,pos.y] := player;
			mov := 2;
		end
		else
		begin
			mov := 0;
			m[tmp.x,tmp.y] := player;
		end;
		resetPossible(mCol,size,tmp,player);
	end;
end;

function togglehlGame(x,y : integer ; size : coord):integer;
// INGOUFF Christian
// Fonction servant à déterminer si le curseur se trouve sur le texte "sauvegarder" (1), "quitter" (2) ou autre part (0)
var
	res : integer;
begin
	if (y > 5 + ((size.y-1)*sizeFrame(size) div 2)) and (y < 35 + ((size.y-1)*sizeFrame(size) div 2)) and (x > 20 + size.x*sizeFrame(size)) then
		res := 1
	else if (y > 5 + ((size.y+1)*sizeFrame(size) div 2)) and (y < 35 + ((size.y+1)*sizeFrame(size) div 2)) and (x > 20 + size.x*sizeFrame(size)) then
		res := 2
	else
		res := 0;
	togglehlGame := res;
end;

procedure load(var m,mCol : matrix ; var size : coord ; n : integer ; var multi, turn, first : integer);
// INGOUFF Christian
// Procédure de chargement d'une partie
var
	f : text;
	i,j : integer;
begin
	assign(f,'save'+inttostr(n)+'.txt');
	reset(f);
	readln(f,turn);
	readln(f,first);
	readln(f,multi);
	readln(f,size.x);
	readln(f,size.y);
	setLength(m,size.x,size.y);
	setLength(mCol,size.x,size.y);
	for j := 0 to size.y-1 do
		for i := 0 to size.x-1 do
		begin
			readln(f,m[i,j]);
			mCol[i,j] := (i+j) mod 2;
		end;
	close(f);
end;

procedure save(var m : matrix ; var size : coord ; n : integer ; multi,turn,first : integer);
// INGOUFF Christian
// Procédure de sauvegarde d'une partie en cours
var
	f : text;
	i,j : integer;
begin
	assign(f,'save'+inttostr(n)+'.txt');
	rewrite(f);
	writeln(f,turn);
	writeln(f,first);
	writeln(f,multi);
	writeln(f,size.x);
	writeln(f,size.y);
	for j := 0 to size.y-1 do
		for i := 0 to size.x-1 do
			writeln(f,m[i,j]);
	close(f);
end;

procedure FreeAll(var image,image2,image3,image4,image5,image6 : gimage);
// RODRIGUEZ Sébastien
// Procédure de libération en masse d'images
begin
		gtexfree(image);
		gtexfree(image2);
		gtexfree(image3);
		gtexfree(image4);
		gtexfree(image5);
		gtexfree(image6);	
end;

function hlSouris(x,y : integer):integer;
// INGOUFF Christian
// Fonction déterminant si le curseur se trouve sur du texte dans les différents menus du menu principal, et du menu sauvegarde
var
	i,res : integer;
begin
	res := 0;
	if (x > (g_scr_w div 2) - 150) and (x < (g_scr_w div 2) + 150) then
	begin
		i := 0;
		while (i < 5) and (res = 0) do
		begin
			if (y > 285+i*40) and (y < 285+i*40+30) then
				res := i+1;
			i := i+1;
		end;
	end;
	hlSouris := res;
end;

procedure catSaveDisp(var bd,save1,save2,save3,retour : gimage ; font : pttf_font ; hl : integer);
// INGOUFF Christian
// Initialisation du texte utilisé dans le menu sauvegarde
begin
	save1 := gTextLoad('SAUVEGARDE I', font);
	save2 := gTextLoad('SAUVEGARDE II', font);
	save3 := gTextLoad('SAUVEGARDE III', font);
	retour := gTextLoad('RETOUR', font);
	blit(130,0,0,g_scr_w,g_scr_h,bd,g_up_left);
	blitText(G_SCR_W div 2,300,save1,colorText(hl=1,fileExists('save1.txt')));
	blitText(G_SCR_W div 2,340,save2,colorText(hl=2,fileExists('save2.txt')));
	blitText(G_SCR_W div 2,380,save3,colorText(hl=3,fileExists('save3.txt')));
	blitText(G_SCR_W div 2,420,retour,colorText(hl=4,false));
end;

procedure saveDisp(fond : integer ; font : PTTF_Font ; m : matrix ; size : coord ; multi, turn, first : integer);
// INGOUFF Christian
// Interface du menu sauvegarde
var
bd,save1,save2,save3,retour : gimage;
hl : integer;
begin
	hl := 0;
	while true do
	begin
		gClear(black);
		changementFond(fond,bd);
		catSaveDisp(bd,save1,save2,save3,retour,font,hl);
		gFlip;
		FreeAll(save1,save2,save3,retour,bd,bd);
		while sdl_update = 1 do
		begin
			hl := hlSouris(sdl_get_mouse_x,sdl_get_mouse_y);
			if sdl_mouse_left_click then
				if (hl > 0) and (hl < 5) then
				begin
					if hl < 4 then
						save(m,size,hl,multi,turn,first);
					exit;
				end;
			if sdl_do_quit then exit;
		end;
	end;
end;

procedure sdlUpdateShenanigans(var m,mCol : matrix ; size : coord ; font : pttf_font ; var mov, player : integer ; var tmp : coord ; hlGame : integer ; multi, fond, first : integer);
// INGOUFF Christian
// Procédure gérant l'ensemble des évènements qui se passent si l'utilisateur vient à cliquer lors de son tour de jeu
var
	pos : coord;
begin
	pos.x := (sdl_get_mouse_x - 20) div sizeFrame(size);
	pos.y := (sdl_get_mouse_y - 20) div sizeFrame(size);
	if (pos.x < size.x) and (pos.y < size.y) then
		eventClick(player,m,mCol,tmp,pos,size,mov)
	else if hlGame = 1 then
		saveDisp(fond,font,m,size,multi,player,first)
	else if hlGame = 2 then
		exit;
	if mov = 2 then
	begin
		mov := 0;
		player := switch(player);
	end;
end;		

procedure game(var m,mCol : matrix ; size : coord ; font : pttf_font ; multi, fond, turn, first : integer ; var win1 : integer);
// INGOUFF Christian
// Procédure de jeu principale
var
	mov,player : integer; // mov = 0 : début du tour ; mov = 1 : sélection ; mov = 2 : fin du tour
	tmp : coord;
	coup : move;
	hlGame : integer;
begin
	mov := 0;
	win1 := 0;
	player := turn;
	while true do
	begin
		hlGame := togglehlGame(sdl_get_mouse_x,sdl_get_mouse_y,size);
		if winCheck(m,size) then
		begin
			if switch(player) = 1 then win1 := 1 else win1 := 2;
			exit;
		end;
		display(m,mCol,size,first,player,fond,font,hlGame);
		if (multi > 0) and (player = 2) then
		begin
			coup := makeMove(m,size,player,multi);
			m[coup.dep.x,coup.dep.y] := 0;
			m[coup.arr.x,coup.arr.y] := player;
			player := switch(player);
		end;
		while sdl_update = 1 do
		begin
			if sdl_do_quit then
				exit;
			if ((player = 1) or (multi = 0)) and sdl_hold_left_click then
			begin
				if hlGame = 2 then exit;
				sdlUpdateShenanigans(m,mCol,size,font,mov,player,tmp,hlGame,multi,fond,first);
			end;
		end;
	end;
end;

end.

// EOF
