program MasterMind;

const 	MAXCOUPS = 10;
				MAXCOULEUR = 7;
				

var		secret: array [1..4] of integer;
		  essais: array [1..MAXCOUPS,1..4] of integer;
			reponses: array [1..MAXCOUPS,1..4] of integer;
			i,j:integer;
			w,h,s,c: integer;
			xa,wa,xb,wb,xd,xe,we,ya:integer;
			quit,comm,play: command;
			key: integer;
			col,oldcol:integer;
			n,m,oldm:integer;
			fin,premier:boolean;
			fond,sous_pointeur,pointeur,oeil:image;
			
{ -----------------------------
  choisit la combinaison à 4 couleurs
	c'est le tableau SECRET, met à zéro les autres tableaux}
procedure choix_combinaison;
begin
	for i:=1 to 4 do
	begin
		secret[i]:=random(MAXCOULEUR)+1;
		for j:=1 to MAXCOUPS do
		begin
			essais[j,i]:=0;
			reponses[j,i]:=0;
		end;
	end;
end;

{ ----------------------------
	convertit un nombre en 3 composantes r,v,b
	en utilisant la forme binaire du numéro de couleur }
procedure fixe_couleur(n:integer);
var r,v,b,grey:integer;
begin
	if n>7 then grey:=192; else grey:=0;
	if odd(n) then r:=255 else r:=grey;
	n:=n/2;
	if odd(n) then v:=255 else v:=grey;
	n:=n/2;
	if odd(n) then b:=255 else b:=grey;
	setcolor(r,v,b);
end;

{------------------------------
dessine chaque cadre avec ombre noire et contour clair}
procedure cadre(xpos,ypos,larg,haut:integer);
begin
	setcolor(0,0,0);
	fillroundrect(xpos+3,ypos+3,larg,haut,9,9);
	setcolor(128,128,128);
	fillroundrect(xpos,ypos,larg,haut,9,9);
	setcolor(212,212,212);
	drawroundrect(xpos,ypos,larg,haut,9,9);
end;

{-----------------------------
	calcule les coordonnées de chaque zone
	et dessine le plateau de jeu:
	- le fond avec l'image répétée
	- les trois cadres
	- les couleurs à choisir à droite}

procedure init_plateau;
var iw,ih:integer;
begin
	if w>h then s:=h-10 else s:=w-10;
	c:=s/9;
	xa:=(w-s)/2;
	wa:=c+c/2+4;
	xb:=xa+wa+4+c/2;
	wb:=4*c+4;
	xe:=xb+wb+c+8;
	xd:=xe-c/2-4;
	we:=c+4;
	ya:=(h-s)/2;
	
	if premier then
	begin
		setcolor(220,220,200);	{ fabrique le pointeur et le sauve }
		fillrect(0,0,c/2,c/2);
		setcolor(255,255,255);
		drawline(0,c/2-1,0,0);
		drawline(0,0,c/2-1,0);
		setcolor(128,128,128);
		drawline(1,c/2-1,c/2-1,c/2-1);
		drawline(c/2-1,c/2-1,c/2-1,1);
		pointeur:=ImageFromCanvas(0,0,c/2,c/2);
		
		fond:=loadimage('/fond.png');		{ dessine le fond }
	end;
	iw:=getImageWidth(fond);
	ih:=GetImageHeight(fond);
	for i:=0 to (w-1)/iw do
		for j:=0 to (h-1)/ih do
			drawimage(fond,iw*i,ih*j);
		
	cadre(xa,ya+s/10,wa,s-s/10);		{ dessine les 3 cadres }
	cadre(xb,ya,wb,s);
	cadre(xe,ya,we,s);
	for i:=1 to MAXCOULEUR do			{ remplit la colonne couleurs }
	begin
		fixe_couleur(i);
		fillellipse(xe+2,ya+s-i*s/10,c,c-4);
	end;
	repaint;
	if premier then 
		sous_pointeur:=ImageFromCanvas(xd,ya+s+c/4-s/10,c/2,c/2);  { sauve le fond sous le pointeur }
	premier:=false;
end;

{-----------------------------------
	déplace l'index devant la colonne des couleurs
	et restaure le fond de l'ancienne position.
	ceci met à jour le pion courant dans le cadre central }
procedure drawindex;
var size:integer;
begin
	drawimage(sous_pointeur,xd,ya+s+c/4-oldcol*s/10);
	if col>MAXCOULEUR then col:=1;
	if col=0 then col:=MAXCOULEUR;
	size:=c/2;
	sous_pointeur:=ImageFromCanvas(xd,ya+s+c/4-col*s/10,size,size);
	drawimage(pointeur,xd,ya+s+c/4-col*s/10);
	oldcol:=col;
	essais[n,m]:=col;
	fixe_couleur(col);
	fillellipse(xb+(m-1)*c+2,ya+s-n*s/10,c,c-4);
	setcolor(0,0,0);
	drawellipse(xb+(m-1)*c+2,ya+s-n*s/10,c,c-4);
	repaint;
end;

{---------------------------------
 lors d'un changement de pion, enlève la marque noire de
	sélection autour du pion précédent.
	Si le nouvezau pion a déjà une couleur on la fixe
	sinon on ne change pas la couleur courante }

procedure ajuste_col;
begin
	fixe_couleur(col);
	drawellipse(xb+(oldm-1)*c+2,ya+s-n*s/10,c,c-4);
	if essais[n,m]<>0 then col:=essais[n,m];
	oldm:=m;
end;

{---------------------------------
	fonction qui vérifie la proposition du joueur
	et remplit le tableau REPONSES
	1: rouge pour un poin bien placé
	7: blanc pour mal placé
	0: pas de pion
	la fonction renvoit TRUE sir le joueur a gagné}

function verif_solution:boolean;
var	propose,sol:array [1..4] of integer;
		p:integer;
begin
	p:=1;
	for i:=1 to 4 do
	begin
		propose[i]:=essais[n,i];
		sol[i]:=secret[i];
		if propose[i]=sol[i] then
		begin
			propose[i]:=-1;
			sol[i]:=-2;
			reponses[n,p]:=1; {couleur rouge}
			p:=p+1;
		end;
	end;
	if p=5 then verif_solution:=true;
	else
	begin
		for i:=1 to 4 do
			for j:=1 to 4 do
				if propose[i]=sol[j] then
				begin
					propose[i]:=-1;
					sol[j]:=-2;
					reponses[n,p]:=7;	{couleur blanche}
					p:=p+1;
				end;
		verif_solution:=false;
	end;
end;

{-------------------------------
 affiche un point réponse selon sa couleur
	ou rien si il vaut zéro}
procedure point(index,xpos,ypos:integer);
begin
	if reponses[n,index]<>0 then
	begin
		fixe_couleur(reponses[n,index]);
		fillrect(xa+2+c/4+xpos*c/3,ya+s-n*s/10+ypos*s/50,c/3,c/3);
	end;
end;

{---------------------------------
	affiche les 4 pions réponse }
procedure affiche_reponse;
begin
	point(1,0,1);
	point(2,2,1);
	point(3,0,3);
	point(4,2,3);
	repaint;
end;

{ ---------------------------------- }
procedure debug;
begin
	for m:=1 to 4 do
	begin
			fixe_couleur(secret[m]);
			fillellipse(xb+(m-1)*c+2,ya,c,c-4);
	end;
end;

{------------------------------------
	si la partie se termine avec TRUE (gagné ou perdue)
	alors:
	si perdue: affiche en haut la solution puis l'alerte
	si gagnée: affiche l'alerte
	Si la partie s'est terminée par EXIT, ne fait rien}
	
procedure fin_partie;
var texte,smiley:string;
begin
	if fin then
	begin
		removeCommand(quit);
		if n=10 then
			begin
				debug;
				texte:='perdu!';
				smiley:='/triste.png';
			end;
		else
		begin
			texte:='gagné!';
			smiley:='/joie.png';
		end;
		repaint;
		delay(2000);
		showAlert('Fin du jeu','Cette fois, vous avez '+texte, LoadImage(smiley),ALERT_INFO);
		fin:=false;
		addCommand(quit);
		addCommand(play);
		repaint;
		repeat
			comm:=getClickedCommand;
		until (comm=quit) or (comm=play);
		removecommand(play);
		removeCommand(quit);
	end;
	else
		removeCommand(quit);
end;

{ ------------------------------------ }
procedure accueil;
var titre,nom,info:string;
		h1,h2,h3,h4,ypos:integer;
begin
	titre:='Master Mind';
	nom:='guillaume.tello@orange.fr';
	info:='MidletPascal 2.02';
	oeil:=Loadimage('/monoeil.png');
	h2:=GetImageHeight(oeil);
	w:=getwidth;
	h:=getheight;
	setcolor(255,255,255);
	fillrect(0,0,w,h);
	setcolor(0,0,0);
	setfont(FONT_FACE_PROPORTIONAL,FONT_STYLE_PLAIN,FONT_SIZE_SMALL);
	h3:=GetStringHeight(nom);
	h4:=GetStringHeight(info);
	setfont(FONT_FACE_SYSTEM,FONT_STYLE_BOLD,FONT_SIZE_LARGE);
	h1:=GetStringHeight(titre);
	ypos:=(h-h1-h2-h3-h4-6)/2;
	drawtext(titre,(w-GetStringWidth(titre))/2,ypos);
	ypos:=ypos+h1+2;
	drawimage(oeil,(w-GetImageWidth(oeil))/2,ypos);
	ypos:=ypos+h2+2;
	setfont(FONT_FACE_PROPORTIONAL,FONT_STYLE_PLAIN,FONT_SIZE_SMALL);
	drawtext(nom,(w-GetStringWidth(nom))/2,ypos);
	ypos:=ypos+h3+2;
	drawtext(info,(w-GetStringWidth(info))/2,ypos);
	addCommand(play);
	repaint;
	SetDefaultFont; 
	repeat
		comm:=getClickedCommand;
	until (comm=play);
	removecommand(play);
end;

{-------------------------------
  programme principal}
begin
	play := createCommand('Play', CM_OK, 1);
	quit := createCommand('Exit', CM_EXIT, 1);
	accueil;
	premier:=true;
  repeat
    addCommand(quit);
		repaint;
		showcanvas;
		init_plateau;
		choix_combinaison;
		{ debug; }
		n:=1;
		oldcol:=1;
		col:=1;		{couleur de début}
		m:=1;			{premier pion}
		oldm:=1;
		drawindex;
		repeat
			key:=keyToAction(getKeyClicked);
			if key <> GA_NONE then
			begin
				if key = GA_UP then
				begin
					col:=col+1;
					drawindex;
				end;  
				if key = GA_DOWN then
				begin
					col:=col-1;
					drawindex;
				end;
				if key = GA_LEFT then
					if m>1 then
					begin
						m:=m-1;
						ajuste_col;
						drawindex;
					end;
				if key = GA_RIGHT then
					if m<4 then
					begin
						m:=m+1;
						ajuste_col;
						drawindex;
					end;
				if key = GA_FIRE then
				begin
					ajuste_col;
					fin:=verif_solution;
					affiche_reponse;
					if fin=false then
					begin
						n:=n+1;
						if n=10 then fin:=true;
						else drawindex;
					end;
				end;
			end;
			comm:=getClickedCommand;
		until (comm=quit) or fin;
		fin_partie;
	until (comm=quit);
end.