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.