Program Solitaire; uses crt, gLib2D, SDL_Addon,SDL,sdl_ttf; type motif = 1..4;{1 =trèfle,2=carreau,3=pique,4=coeur} carte = record couleur : motif; { 1 =trèfle,2=carreau,3=pique,4=coeur } numero : integer; { valeur affectée à la carte } profil : Boolean; { Si carte visible : true, si carte masquée : false } end; type ptr_noeud = ^noeud; noeud = record valeur : carte; suivant : ptr_noeud; end; var compteur1 , I : integer; listeP,liste1,liste2,liste3,liste4,liste5,liste6,liste7,listePioche,F1,F2,F3,F4,listeDefausse: ptr_noeud; screen,dos,caro_1, caro_2,caro_3,caro_4,caro_5,caro_6,caro_7,caro_8,caro_9,caro_10,caro_11,caro_12,caro_13 : gImage; coeur_1, coeur_2,coeur_3,coeur_4,coeur_5,coeur_6,coeur_7,coeur_8,coeur_9,coeur_10,coeur_11,coeur_12,coeur_13 : gImage; trefle_1, trefle_2,trefle_3,trefle_4,trefle_5,trefle_6,trefle_7,trefle_8,trefle_9,trefle_10,trefle_11,trefle_12,trefle_13 : gImage; pic_1, pic_2,pic_3,pic_4,pic_5,pic_6,pic_7,pic_8,pic_9,pic_10,pic_11,pic_12,pic_13 : gImage; alpha, w, h, rot : integer; x, y : real; {********************************************************************************************************************************************} Procedure chargement(); begin screen:=gTexLoad('image.png'); dos:=gTexLoad('dos.png'); trefle_1:=gTexLoad('1-1.png'); trefle_2:=gTexLoad('1-2.png'); trefle_3:=gTexLoad('1-3.png'); trefle_4:=gTexLoad('1-4.png'); trefle_5:=gTexLoad('1-5.png'); trefle_6:=gTexLoad('1-6.png'); trefle_7:=gTexLoad('1-7.png'); trefle_8:=gTexLoad('1-8.png'); trefle_9:=gTexLoad('1-9.png'); trefle_10:=gTexLoad('1-10.png'); trefle_11:=gTexLoad('1-11.png'); trefle_12:=gTexLoad('1-12.png'); trefle_13:=gTexLoad('1-13.png'); caro_1:=gTexLoad('2-1.png'); caro_2:=gTexLoad('2-2.png'); caro_3:=gTexLoad('2-3.png'); caro_4:=gTexLoad('2-4.png'); caro_5:=gTexLoad('2-5.png'); caro_6:=gTexLoad('2-6.png'); caro_7:=gTexLoad('2-7.png'); caro_8:=gTexLoad('2-8.png'); caro_9:=gTexLoad('2-9.png'); caro_10:=gTexLoad('2-10.png'); caro_11:=gTexLoad('2-11.png'); caro_12:=gTexLoad('2-12.png'); caro_13:=gTexLoad('2-13.png'); pic_1:=gTexLoad('3-1.png'); pic_2:=gTexLoad('3-2.png'); pic_3:=gTexLoad('3-3.png'); pic_4:=gTexLoad('3-4.png'); pic_5:=gTexLoad('3-5.png'); pic_6:=gTexLoad('3-6.png'); pic_7:=gTexLoad('3-7.png'); pic_8:=gTexLoad('3-8.png'); pic_9:=gTexLoad('3-9.png'); pic_10:=gTexLoad('3-10.png'); pic_11:=gTexLoad('3-11.png'); pic_12:=gTexLoad('3-12.png'); pic_13:=gTexLoad('3-13.png'); coeur_1:=gTexLoad('4-1.png'); coeur_2:=gTexLoad('4-2.png'); coeur_3:=gTexLoad('4-3.png'); coeur_4:=gTexLoad('4-4.png'); coeur_5:=gTexLoad('4-5.png'); coeur_6:=gTexLoad('4-6.png'); coeur_7:=gTexLoad('4-7.png'); coeur_8:=gTexLoad('4-8.png'); coeur_9:=gTexLoad('4-9.png'); coeur_10:=gTexLoad('4-10.png'); coeur_11:=gTexLoad('4-11.png'); coeur_12:=gTexLoad('4-12.png'); coeur_13:=gTexLoad('4-13.png'); end; { chargement } {********************************************************************************************************************************************} function suppriTete(teteliste : ptr_noeud):ptr_noeud; { permet de supprimer le premier pointeur d'une liste (et la valeur vers laquelle il pointe) } var tete : ptr_noeud; begin if teteliste = nil then { permet de vérifier si la liste est vide et donc s'il est possible de supprimer le pointeur } begin writeln('la liste est vide'); suppriTete := teteliste end else begin if teteliste^.suivant=NIL then begin suppriTete:=NIL; writeln('La liste est vide'); end else begin tete := teteliste^.suivant; { permet de passer la tete de liste sur le pointeur suivant } dispose(teteliste); { supprimme l'ancien tete de liste } suppriTete := tete; end; end; end; { suppriTete } {********************************************************************************************************************************************} function supprKieme(teteliste:ptr_noeud;pos:integer):ptr_noeud; { permet de supprimer une valeur contenu dans la liste à partir de sa position } var l,p :ptr_noeud;i:integer; begin l := teteliste; i := 1; if pos = 1 then { permet de supprimer la valeur si elle est en premiere position de la liste } supprKieme := suppriTete(teteliste) else begin if l = nil then { permet de verifier si la liste est nulle } begin writeln('la liste est vide'); supprKieme := l end else begin if l^.suivant = nil then { permet de verifier si l'on n'est pas sorti de la liste } begin writeln('Hors liste'); supprKieme := l end else begin { permet de parcourir la liste jusqu'a la position voulue } while(l^.suivant^.suivant <> nil) and (i nil) do begin l := l^.suivant; end; p := l^.suivant; l^.suivant := nil; dispose(p); //liberer le dernier suppriFin := teteliste; end; end; end; { suppriFin } {*********************************************************************************************************************************} Procedure afficher(p : ptr_noeud; x,y:integer); var i : integer; thecarte: gImage; t:ptr_noeud; begin t:=p; i:=0; If (t=NIL) then begin gBeginRects(nil); gSetColor(BLACK); gSetScaleWH(155, 220); gSetAlpha(100); gSetCoord(x ,y ); gAdd(); gEnd(); end; While (t<>nil) do begin If (t^.valeur.profil=false) then begin gBeginRects(dos); gSetAlpha(255); gSetScaleWH(155, 220); If (p=listePioche) or (p=listeDefausse)then gSetCoord(x ,y) else gSetCoord(x ,y+i*50); gAdd(); gEnd(); end else begin if (t^.valeur.numero=1) then begin if (t^.valeur.couleur=1) then thecarte:=trefle_1; if (t^.valeur.couleur=2) then thecarte:=caro_1; if (t^.valeur.couleur=3) then thecarte:=pic_1; if (t^.valeur.couleur=4) then thecarte:=coeur_1; end; if (t^.valeur.numero=2) then begin if (t^.valeur.couleur=1) then thecarte:=trefle_2; if (t^.valeur.couleur=2) then thecarte:=caro_2; if (t^.valeur.couleur=3) then thecarte:=pic_2; if (t^.valeur.couleur=4) then thecarte:=coeur_2; end; if (t^.valeur.numero=3) then begin if (t^.valeur.couleur=1) then thecarte:=trefle_3; if (t^.valeur.couleur=2) then thecarte:=caro_3; if (t^.valeur.couleur=3) then thecarte:=pic_3; if (t^.valeur.couleur=4) then thecarte:=coeur_3; end; if (t^.valeur.numero=4) then begin if (t^.valeur.couleur=1) then thecarte:=trefle_4; if (t^.valeur.couleur=2) then thecarte:=caro_4; if (t^.valeur.couleur=3) then thecarte:=pic_4; if (t^.valeur.couleur=4) then thecarte:=coeur_4; end; if (t^.valeur.numero=5) then begin if (t^.valeur.couleur=1) then thecarte:=trefle_5; if (t^.valeur.couleur=2) then thecarte:=caro_5; if (t^.valeur.couleur=3) then thecarte:=pic_5; if (t^.valeur.couleur=4) then thecarte:=coeur_5; end; if (t^.valeur.numero=6) then begin if (t^.valeur.couleur=1) then thecarte:=trefle_6; if (t^.valeur.couleur=2) then thecarte:=caro_6; if (t^.valeur.couleur=3) then thecarte:=pic_6; if (t^.valeur.couleur=4) then thecarte:=coeur_6; end; if (t^.valeur.numero=7) then begin if (t^.valeur.couleur=1) then thecarte:=trefle_7; if (t^.valeur.couleur=2) then thecarte:=caro_7; if (t^.valeur.couleur=3) then thecarte:=pic_7; if (t^.valeur.couleur=4) then thecarte:=coeur_7; end; if (t^.valeur.numero=8) then begin if (t^.valeur.couleur=1) then thecarte:=trefle_8; if (t^.valeur.couleur=2) then thecarte:=caro_8; if (t^.valeur.couleur=3) then thecarte:=pic_8; if (t^.valeur.couleur=4) then thecarte:=coeur_8; end; if (t^.valeur.numero=9) then begin if (t^.valeur.couleur=1) then thecarte:=trefle_9; if (t^.valeur.couleur=2) then thecarte:=caro_9; if (t^.valeur.couleur=3) then thecarte:=pic_9; if (t^.valeur.couleur=4) then thecarte:=coeur_9; end; if (t^.valeur.numero=10) then begin if (t^.valeur.couleur=1) then thecarte:=trefle_10; if (t^.valeur.couleur=2) then thecarte:=caro_10; if (t^.valeur.couleur=3) then thecarte:=pic_10; if (t^.valeur.couleur=4) then thecarte:=coeur_10; end; if (t^.valeur.numero=11) then begin if (t^.valeur.couleur=1) then thecarte:=trefle_11; if (t^.valeur.couleur=2) then thecarte:=caro_11; if (t^.valeur.couleur=3) then thecarte:=pic_11; if (t^.valeur.couleur=4) then thecarte:=coeur_11; end; if (t^.valeur.numero=1) then begin if (t^.valeur.couleur=1) then thecarte:=trefle_1; if (t^.valeur.couleur=2) then thecarte:=caro_1; if (t^.valeur.couleur=3) then thecarte:=pic_1; if (t^.valeur.couleur=4) then thecarte:=coeur_1; end; if (t^.valeur.numero=12) then begin if (t^.valeur.couleur=1) then thecarte:=trefle_12; if (t^.valeur.couleur=2) then thecarte:=caro_12; if (t^.valeur.couleur=3) then thecarte:=pic_12; if (t^.valeur.couleur=4) then thecarte:=coeur_12; end; if (t^.valeur.numero=13) then begin if (t^.valeur.couleur=1) then thecarte:=trefle_13; if (t^.valeur.couleur=2) then thecarte:=caro_13; if (t^.valeur.couleur=3) then thecarte:=pic_13; if (t^.valeur.couleur=4) then thecarte:=coeur_13; end; gBeginRects(thecarte); gSetAlpha(255); If (p=listePioche) or (p=listeDefausse) or (p=F1) or (p=F2) or (p=F3) or (p=F4)then gBlit(x,y,thecarte,155,220) else gBlit(x, y+i*50,thecarte, 155,220); gEnd(); end; t:=t^.suivant; i:=i+1 end; end; { afficher } {********************************************************************************************************************************************} procedure afficher1 (p : ptr_noeud); { Permet d'afficher les valeurs de chaque carte contenu dans une liste souhaitée,(liste souhaitée passée en paramètre } var t : ptr_noeud; begin t:=p; If (t=NIL) then writeln(' => Liste Vide'); while (t<>NIL) do {permet de parcourir toute la liste } begin write(t^.valeur.couleur); { affiche le motif de la carte } write('--',t^.valeur.numero); { affiche la valeur de la carte } writeln('--',t^.valeur.profil);{ affiche le profil de la carte } t:=t^.suivant; end; writeln(''); end; { afficher } {*********************************************************************************************************************************} function ajoutFin(liste_origine:ptr_noeud; karte: carte):ptr_noeud; {permet d'ajouter un pointeur à la fin de la liste} var fin,l:ptr_noeud; begin new(fin); fin^.valeur.couleur:= karte.couleur; fin^.valeur.numero:= karte.numero; fin^.valeur.profil:=false; fin^.suivant := nil; l := liste_origine; if l = nil then ajoutFin := fin else begin while (l^.suivant <> nil) do begin l := l^.suivant; end; l^.suivant := fin; ajoutFin := liste_origine; end; end; { ajoutFin } {*********************************************************************************************************************************} function ajoutTete(teteliste : ptr_noeud; karte:carte):ptr_noeud; {permet d'ajouter un pointeur au début de la liste} var tete:ptr_noeud; begin new(tete); tete^.valeur.couleur := karte.couleur; tete^.valeur.numero:=karte.numero; tete^.valeur.profil:=karte.profil; tete^.suivant := teteliste; ajoutTete := tete; end; { ajoutTete } {*********************************************************************************************************************************} function ajoutKieme(liste_origine : ptr_noeud; pos:integer; karte : carte):ptr_noeud; {permet d'ajouter un pointeur à la position souhaitée } var l,p,tmp:ptr_noeud;i:integer; begin new(p); p^.valeur.couleur := karte.couleur; p^.valeur.numero:=karte.numero; p^.valeur.profil:=karte.profil; l := liste_origine; i := 1; if pos = 1 then ajoutKieme := ajoutTete(liste_origine,karte) else begin if (l = nil) then begin ajoutKieme := l end else begin while( l <> nil) and (i nil) then begin tmp := l^.suivant; l^.suivant := p; p^.suivant := tmp; ajoutKieme := liste_origine; end else begin ajoutKieme := liste_origine end ; end; end; end; { ajoutKieme } {*********************************************************************************************************************************} Procedure creerListeP; {permet de créer le paquet de cartes} var k,p : ptr_noeud; c:carte; j,i:integer; begin new(listeP); k:=listeP; c.couleur:=1; c.numero:=1; c.profil:=false; { initialise toutes les cartes à masquer } k^.valeur:=c; { i represente le motif de la carte } For i:=1 to 4 do {on parcourt chaque motif d'un jeu de carte: trèfle(1),carreaux(2),pique(3),coeur(4)} begin if (i=1) then begin { j represente la valeur de la carte } for j:=2 to 13 do { on met en place chaque carte du jeu en leur associant un numéro, le 1 étant l'as,etc jusqu'au roi qui est le 13} begin { commence a 2 si i=1 car la carte 1-1 est deja initialisé pour creer la tete de liste } new(p); k^.suivant:=p; c.couleur:=i; c.numero:=j; p^.valeur:=c; k:=p; end; end else begin for j:=1 to 13 do { on met en place chaque carte du jeu en leur associant un numéro, le 1 étant l'as,etc jusqu'au roi qui est le 13} begin new(p); k^.suivant:=p; c.couleur:=i; c.numero:=j; p^.valeur:=c; k:=p; end; end; end; end; { creerListeP } {********************************************************************************************************************************************} Function creerliste(c:carte;teteliste:ptr_noeud):ptr_noeud; { permet de creer une liste a partir de la valeur passée en parametre et de la tete de liste de la liste } var l,p : ptr_noeud; begin new(p); { creer le nouveau noeud de la liste } p^.valeur:=c; { ajoute la valeur à la liste } p^.suivant:=NIL; If (teteliste=NIL) then { permet de verifier si la liste est vide } creerliste:=p { creer la liste si celle-ci est vide } else begin { si la liste n'est pas vide } l:=teteliste; while (l^.suivant<>NIL) do { parcourt la liste jusqu'a sa derniere valeur } l:=l^.suivant; { ajoute la valeur a la liste } l^.suivant:=p; creerliste:=teteliste; end; end; { ajoutFin } {********************************************************************************************************************************************} procedure repartircarte (c: carte); {permet d'envoyer les cartes dans chaque colonne du plateau du solitaire} begin { le compteur est une variable globale qui est reliée à la fonction choixaleatoirelisteP } case compteur1 of 1 : {1ère colonne du tableau donc 1 seule carte} begin liste1:=creerliste(c,liste1);{motif et numéro,pointeur de la liste 1,nombre de cartes à mettre} compteur1:=compteur1+1; end; 2..3:{2eme colonne du tableau donc 2 cartes} begin liste2:=creerliste(c,liste2); compteur1:=compteur1+1; end; 4..6:{3ème colonne du tableau donc 3 cartes} begin liste3:=creerliste(c,liste3); compteur1:=compteur1+1; end; 7..10:{etc} begin liste4:=creerliste(c,liste4); compteur1:=compteur1+1; end; 11..15: begin liste5:=creerliste(c,liste5); compteur1:=compteur1+1; end; 16..21: begin liste6:=creerliste(c,liste6); compteur1:=compteur1+1; end; 22..28: begin liste7:=creerliste(c,liste7); compteur1:=compteur1+1; end; 29..52: begin listePioche:=creerliste(c,listePioche); {la fin du paquet de cartes est mélangé en créant une nouvelle liste} compteur1:=compteur1+1; end; end; { case } end; { repartircarte } {********************************************************************************************************************************************} procedure choixaleatoirelisteP; {pioche une carte de façon aléatoire dans le paquet de cartes} var i,compt : integer; ptr:ptr_noeud; nbboucle:integer;carte1:carte; begin randomize; { necessaire pour utiliser le random } compt:=52; { le compteur permet de savoir si toutes les cartes ont été distribuées } carte1.couleur:=1; { initialisation de la premiere carte } carte1.numero:=1; while(compt<>0) do begin ptr:=listeP; nbboucle:=random(compt)+1; {on choisit la position d'une carte aléatoirement} if (nbboucle<>1) then begin for i:=1 to nbboucle-1 do {on parcourt le jeu de cartes jusqu'à atteindre cette carte} begin ptr:=ptr^.suivant; end; end; carte1.couleur:=ptr^.valeur.couleur; { donne à carte1 la valeur de la carte a distribuer } carte1.numero:=ptr^.valeur.numero; carte1.profil:=ptr^.valeur.profil; repartircarte(carte1); {permet de répartir les cartes piochées sur le plateau} listeP:= supprKieme(ListeP,nbboucle); {on supprime la carte choisit dans le paquet} compt:=compt-1; end; end; { choixaleatoirelisteP } {********************************************************************************************************************************************} procedure demasquer_derniere_carte(teteliste : ptr_noeud); { permet de demasquer la derniere carte de la liste passée en paramètre } var ptr, ptr_suivant : ptr_noeud; begin ptr:=teteliste; if ptr <> NIL then begin ptr_suivant:=ptr^.suivant; While (ptr_suivant<>NIL) do { parcourt la liste jusqu'à la derniere carte } begin ptr_suivant:=ptr_suivant^.suivant; ptr:=ptr^.suivant; end; ptr^.valeur.profil:=true; { change la valeur du profil de la carte } end; end; {********************************************************************************************************************************************} procedure demasquage; { demasque la derniere carte des listes du plateau } begin demasquer_derniere_carte(liste1); demasquer_derniere_carte(liste2); demasquer_derniere_carte(liste3); demasquer_derniere_carte(liste4); demasquer_derniere_carte(liste5); demasquer_derniere_carte(liste6); demasquer_derniere_carte(liste7); end; {********************************************************************************************************************************************} procedure initialiser_variables; { cette fonction initialise toutes les variables utilisées dans la distribution des cartes } begin liste1:=NIL; liste2:=NIL; liste3:=NIL; liste4:=NIL; liste5:=NIL; liste6:=NIL; liste7:=NIL; listeP:=NIL; listePioche:=NIL; listeDefausse:=NIL; compteur1:=1; F1:=NIL; F2:=NIL; F3:=NIL; F4:=NIL; end; {********************************************************************************************************************************************} procedure distribution_des_cartes; { cette fonction permet d'appeler les fonctions réalisant la distributions des cartes } Begin initialiser_variables; creerlisteP; choixaleatoirelisteP; demasquage; end; {********************************************************************************************************************************************} procedure affichage_position_cartes_plateau; { cette fonction permet d'afficher toutes les listes presentent sur le plateau } Begin { cette fonction est utile pour vérifier la fonctionnalité de nos fonctions } writeln('AFFICHAGE'); writeln('*************************************** '); writeln('liste1'); afficher1(liste1); afficher(liste1,40,350); writeln('************************** '); writeln('liste2'); afficher1(liste2); afficher(liste2,250,350); writeln('***************** '); writeln('liste3'); afficher1(liste3); afficher(liste3,460,350); writeln('***************** '); writeln('liste4'); afficher1(liste4); afficher(liste4,670,350); writeln('******************** '); writeln('liste5'); afficher1(liste5); afficher(liste5,880,350); writeln('********************* '); writeln('liste6'); afficher1(liste6); afficher(liste6,1090,350); writeln('************************ '); writeln('liste7'); afficher1(liste7); afficher(liste7,1300,350); writeln('************************ '); writeln('listePioche '); afficher1(listePioche); afficher(listePioche,40,40); writeln('************************ '); writeln('listeDefausse '); afficher1(listeDefausse); afficher(listeDefausse,250,40); writeln('************************ '); writeln('ListeRange1 (8)'); afficher1(F1); afficher(F1,670,40); writeln('************************ '); writeln('ListeRange2 (9)'); afficher1(F2); afficher(F2,880,40); writeln('************************ '); writeln('ListeRange3 (10)'); afficher1(F3); afficher(F3,1090,40); writeln('************************ '); writeln('ListeRange4 (11)'); afficher1(F4); afficher(F4,1300,40); end; { affichage_position_cartes_plateau } {********************************************************************************************************************************************} function condition_decroissante(liste_origine, liste_arrivee : ptr_noeud) :Boolean;{permet de vérifier s'il est possible de deplacer la carte par rapport a l'ordre decroissant} Begin If((liste_origine^.valeur.numero)+1=liste_arrivee^.valeur.numero) then condition_decroissante:=true { si decroissant alors vrai} else condition_decroissante:=false; { si croissant alors faux } end; { condition_decroissante } {********************************************************************************************************************************************} function condition_couleur_differente(liste_origine, liste_arrivee : ptr_noeud):Boolean; { permet de verifier si les carte à deplacer sont bien de couleur differentes } Begin If( liste_origine^.valeur.couleur=1)or(liste_origine^.valeur.couleur=3)then { si carte noire } Begin If(liste_arrivee^.valeur.couleur=2)or(liste_arrivee^.valeur.couleur=4)then condition_couleur_differente :=true { vrai si on deplace sur carte rouge } else condition_couleur_differente:=false; { faux si on deplace sur une carte noire } end else { si carte rouge } begin If(liste_arrivee^.valeur.couleur=1)or(liste_arrivee^.valeur.couleur=3)then condition_couleur_differente :=true { vrai si on deplace sur une carte noire } else condition_couleur_differente:=false; { faux si on deplace sur une carte rouge } end; end; { condition_couleur_differente } {********************************************************************************************************************************************} Function condition_couleur_similaire(liste_origine, liste_arrivee : ptr_noeud):Boolean; {permet de verifier s'il est possible de bien ranger la carte sur la liste finale par rapport à la couleur.} Begin case liste_origine^.valeur.couleur of 1 : {Si carte = trèfle} Begin If(liste_arrivee^.valeur.couleur=1) then condition_couleur_similaire:=true {vrai si carte déposée= trèfle} else condition_couleur_similaire:=false; {faux si carte différente} end; 2 : {Si carte = carreau} Begin If(liste_arrivee^.valeur.couleur=2) then {vrai si carte deposée=carreau} condition_couleur_similaire:=true else condition_couleur_similaire:=false; {faux si carte différente} end; 3 : {Si carte = pique} Begin If(liste_arrivee^.valeur.couleur=3) then condition_couleur_similaire:=true {vrai si carte deposée=pique} else condition_couleur_similaire:=false; {faux si carte différente} end; 4 : {Si carte = coeur} Begin If(liste_arrivee^.valeur.couleur=4) then condition_couleur_similaire:=true {vrai si carte deposée=coeur} else condition_couleur_similaire:=false; {faux si carte différente} end; end; { case } end; { condition_couleur_similaire } {********************************************************************************************************************************************} Function condition_croissante(liste_origine, liste_arrivee : ptr_noeud):Boolean; {permet de vérifier s'il est possible de ranger la carte sur la liste finale par rapport à l'ordre croissant} Begin If(liste_origine^.valeur.numero=(liste_arrivee^.valeur.numero)+1) then condition_croissante:=true { si croissant alors vrai} else condition_croissante:=false;{ si decroissant alors faux} end; { condition_croissante } {********************************************************************************************************************************************} Function condition_vide (liste_origine, liste_arrivee : ptr_noeud):Boolean; {permet de dire si la carte est un roi ou pas.} Begin If liste_origine^.valeur.numero=13 then condition_vide:=true else condition_vide:=false; end; { condition_vide } {********************************************************************************************************************************************} Function condition_as (liste_origine : ptr_noeud):Boolean; {permet de dire si la carte est un as ou pas.} Begin If liste_origine^.valeur.numero=1 then condition_as:=true else condition_as:=false; end; { condition_as } {********************************************************************************************************************************************} Procedure piocher; {permet de faire défiler la pioche dans la defausse} var ptr, ptr_suivant : ptr_noeud; karte : carte; Begin ptr:=listePioche; ptr_suivant:=ptr^.suivant; while (ptr_suivant<>NIL) do begin ptr:=ptr_suivant; ptr_suivant:=ptr_suivant^.suivant; end; karte.numero:=ptr^.valeur.numero; karte.couleur:=ptr^.valeur.couleur; karte.profil:=true; listeDefausse:=creerliste(karte, listeDefausse); {envoie la carte dans la defausse et la supprime de la pioche} listePioche:=suppriFin(listePioche); end; { piocher } {********************************************************************************************************************************************} Function condition_defausse (liste_origine,liste_origine_condition :ptr_noeud):Boolean; {verifie les conditions pour la defausse} var ptr, ptr_suivant : ptr_noeud; Begin ptr:=liste_origine; ptr_suivant:=ptr^.suivant; While ptr_suivant<>NIL do begin ptr:=ptr_suivant; ptr_suivant:=ptr_suivant^.suivant; end; If (ptr^.valeur.couleur=liste_origine_condition^.valeur.couleur) and (ptr^.valeur.numero=liste_origine_condition^.valeur.numero)then condition_defausse:=true else condition_defausse:=false end; { condition_defausse } {********************************************************************************************************************************************} Function compter (liste_origine : ptr_noeud):integer; {permet de compter les cartes de la liste passé en paramètre} Var ptr,ptr_suivant : ptr_noeud; compt:integer; Begin compt:=1; ptr:=liste_origine; ptr_suivant:=ptr^.suivant; While ptr_suivant<>NIL do begin ptr:=ptr_suivant; ptr_suivant:=ptr_suivant^.suivant; compt:=compt+1; end; compter:=compt; end; { compter } {********************************************************************************************************************************************} Procedure piocher_2; {permet de faire défiler la defausse dans la pioche} var ptr, ptr_suivant : ptr_noeud; karte : carte; Begin ptr:=listeDefausse; ptr_suivant:=ptr^.suivant; while (ptr_suivant<>NIL) do begin ptr:=ptr_suivant; ptr_suivant:=ptr_suivant^.suivant; end; karte.numero:=ptr^.valeur.numero; karte.couleur:=ptr^.valeur.couleur; karte.profil:=false; listePioche:=creerliste(karte, listePioche); listeDefausse:=suppriFin(listeDefausse); end; { piocher } {********************************************************************************************************************************************} Procedure majpioche; {permet de mettre à jour la pioche (remettre la defausse dedans dans le bon ordre)} var compt : integer; Begin If listePioche=NIL then begin compt:=compter(listeDefausse); while compt<>0 do begin piocher_2; compt:=compt-1; end; end else piocher; end; { majpioche } {********************************************************************************************************************************************} Function conditions(liste_origine, liste_arrivee, liste_origine_condition, liste_arrivee_condition : ptr_noeud):Boolean; {regroupe la vérification des différentes conditions.} begin conditions:=false; If (liste_origine_condition^.valeur.profil=true)then begin If (liste_origine=listeDefausse) and (condition_defausse(liste_origine, liste_origine_condition)=false) then conditions:=false else begin If(liste_arrivee=F1)or(liste_arrivee=F2)or(liste_arrivee=F3)or(liste_arrivee=F4)then begin If (liste_origine_condition^.suivant<>NIL)and (liste_origine<>listeDefausse)then conditions:=false else begin If (liste_arrivee=NIL) then conditions:=condition_as(liste_origine_condition) else begin If (condition_croissante(liste_origine_condition, liste_arrivee_condition)=false)or(condition_couleur_similaire(liste_origine_condition, liste_arrivee_condition)=false)then conditions:=false else conditions:=true; end; end; end; If(liste_arrivee=liste1) or(liste_arrivee=liste2)or (liste_arrivee=liste3)or(liste_arrivee=liste4)or(liste_arrivee=liste5)or(liste_arrivee=liste6)or(liste_arrivee=liste7)then begin If (liste_arrivee=NIL) then conditions:=condition_vide(liste_origine_condition, liste_origine_condition) else begin If (condition_decroissante(liste_origine_condition, liste_arrivee_condition)=false) or (condition_couleur_differente(liste_origine_condition, liste_arrivee_condition)=false)then begin conditions:=false; end else begin conditions:=true; end; end; end; end; end; end; { conditions } {*******************************************************************************************************************************************} Function chargement_carte_a_deplacer( liste : ptr_noeud; position : integer):ptr_noeud; {permet de récupérer le pointeur qui pointe vers la carte que l'on souhaite déplacer} var I : integer; ptr : ptr_noeud; begin ptr:=liste; for I:=1 to position-1 do begin ptr:=ptr^.suivant; end; If (ptr=NIL)then writeln('impossible cette position n est pas dans la liste'); chargement_carte_a_deplacer:=ptr; end; { chargement_carte_a_deplacer } {********************************************************************************************************************************************} Function chargement_arrivee(liste : ptr_noeud):ptr_noeud; {permet de récupérer le pointeur qui pointe vers la carte sur laquel on veut déplacer notre carte} var ptr, ptr_suivant : ptr_noeud; begin ptr:=liste; if ptr<>Nil then begin ptr_suivant:=ptr^.suivant; while (ptr_suivant<>NIL)do begin ptr:=ptr_suivant; ptr_suivant:=ptr_suivant^.suivant; end; end; chargement_arrivee:=ptr; end; { chargement_arrivee } {*******************************************************************************************************************************************} procedure liberer(liste_depart :ptr_noeud; position : integer); {permet de libérer le pointeur de la liste passé en paramètre} var i:integer; begin For i:= 1 to position do liste_depart:=liste_depart^.suivant; dispose(liste_depart); end;{liberer} {*******************************************************************************************************************************************} function nombre_deplacement(liste_depart : ptr_noeud ; position : integer): integer; {permet de calculer le nombre de carte à déplacer} var compt : integer; ptr : ptr_noeud; begin ptr:=chargement_carte_a_deplacer(liste_depart, position); ptr:=ptr^.suivant; compt:=1; while ptr<>NIL do begin compt:=compt+1; ptr:=ptr^.suivant; end; nombre_deplacement:=compt; end; { nombre_deplacement } {********************************************************************************************************************************************} procedure deplacement(var liste_depart, liste_darrivee : ptr_noeud ; position : integer) ; var p, liste_origine_condition, liste_arrivee_condition : ptr_noeud; begin liste_origine_condition:=chargement_carte_a_deplacer(liste_depart, position); {permet d'obtenir le pointeur pointant vers la carte à déplacer}{ stocker en variable globale car servant pour les conditons partculieres} if (liste_darrivee <> NIL) then liste_arrivee_condition:=chargement_arrivee(liste_darrivee) {permet d'obtenir le pointeur pointant vers la carte d'arrivee} else begin liste_arrivee_condition:=NIL; end; If (conditions(liste_depart,liste_darrivee, liste_origine_condition, liste_arrivee_condition)=true)then begin new(p); {creer le nouveau noeud pour la lste a laquelle on ajoute la carte} p^.valeur.couleur:=liste_origine_condition^.valeur.couleur; {sauvegarde la couleur de la carte} p^.valeur.numero:=liste_origine_condition^.valeur.numero; {sauvegarde la valeur de la carte} p^.valeur.profil:=liste_origine_condition^.valeur.profil; {sauvegarde le profil de la carte} liste_depart:=supprKieme(liste_depart,position); {supprimme l'ancienne carte} If (liste_darrivee=NIL) then begin liste_darrivee:=p; end else liste_arrivee_condition^.suivant:=p; {ajoute le nouveau noeud à la suite de la liste d'arrivee} end else writeln('impossible de deplacer la carte'); end; { deplacement } {*******************************************************************************************************************************************} procedure essai_deplacement; {procédure qui regroupe toutes les procédures afin de déplacer les cartes} var choix_liste1, choix_liste2,l : ptr_noeud; x,y, x1,y1, choix_pos,i, compteur : integer; begin choix_liste1:=NIL; If sdl_mouse_left_click then begin x := sdl_get_mouse_x; y:= sdl_get_mouse_y; Sdl_update; If (40i then deplacement(choix_liste1, choix_liste2, i) else deplacement(choix_liste1, choix_liste2, choix_pos); end; { end;} { end;} { end;} end; case x1 of 40..195: begin liste1 :=choix_liste2; end; 250..405: begin If (350 opaque *) x := G_SCR_W div 2; (* Middle of screen *) y := G_SCR_H div 2; (* Middle of screen *) w := (*image^.w*)2000; (* width = image width *) h := (*image^.h*)1400; (* height = image height *) rot := 0; gBeginRects(screen); gSetCoordMode(G_CENTER); gSetAlpha(alpha); gSetScaleWH(w, h); gSetCoord(x, y); gSetRotation(rot); gAdd(); gEnd(); affichage_position_cartes_plateau; gFlip(); while condition_darret=false do begin sdl_update; essai_deplacement; demasquage; alpha := 255; (* Alpha = 255 => opaque *) x := G_SCR_W div 2; (* Middle of screen *) y := G_SCR_H div 2; (* Middle of screen *) w := (*image^.w*)2000; (* width = image width *) h := (*image^.h*)1400; (* height = image height *) rot := 0; IF sdl_do_quit then halt; gBeginRects(screen); gSetCoordMode(G_CENTER); gSetAlpha(alpha); gSetScaleWH(w, h); gSetCoord(x, y); gSetRotation(rot); gAdd(); gEnd(); affichage_position_cartes_plateau; gFlip(); end; {while (sdl_update = 1) do BEGIN if (sdl_do_quit) then exit; END;} end; end; end.