'=========================================================================== ' Subject: FRENCH MORPION (TICTACTOE LIKE) Date: 01-01-00 (14:41) ' Author: Sylvain Bizorre Code: RAPIDQ ' Origin: sbfg@wanadoo.fr Packet: RAPIDQ.ABC '=========================================================================== $TYPECHECK ON declare sub AfficheCoup ' Affiche le coup de l'ordi ou du joueur declare sub CalculScores ' Met à jour la grille après un coup joué declare sub CommencerPartie ' Détermine les couleurs de chaque joueur declare sub InitTableau ' Initialisation du tableau de grille declare sub JeuJoueur ' Coup du joueur declare sub JeuOrdi ' Coup de l'ordinateur declare sub JoueurCommence ' Le joueur choisit de commencer declare sub OrdiCommence ' C'est l'ordi qui commence declare sub AfficheGrille ' Affiche la grille declare sub Quitter declare sub Grille10 ' Sélection des 3 dimensions de grille declare sub Grille15 declare sub Grille20 declare sub PrefereRouge ' Le joueur préfère les rouges declare sub PrefereBleu ' ... ou les bleus declare sub JaiGagne declare sub TextesOrigine ' Textes de base de la fenêtre d'infos CONST ORDI = 0 CONST JOUEUR = 1 const VRAI = 1 const FAUX = 0 const ROUGE = &HFF const BLEU = &HFFOOOO dim AfficheCoupX as word ' Coordonnées X, Y du coup à afficher dim AfficheCoupY as word dim Numalign as integer NumAlign = 2 * (21 - 4) * ((2 * 21) - 4) DIM CoupJoueurOrdi(21, 21) as integer 'Tableau des cases jouées par le joueur (-1), l'ordi (1) ou no jouées (0) dim al(21, 21, 0 to 20) as integer dim NbrPionsAlign(Numalign) as integer dim OrdiJoue as Integer dim Ponderation(5) as word dim Gauche as Integer ' Position gauche de la grille dim Haut as Integer ' Haute dim Largeur as Integer ' Largeur de la grille dim Hauteur as Integer ' Hauteur dim NumeroRangee as integer ' Pour numéroter les rangées de la grille dim CouleurJoueur as integer ' Couleur choisie par le joueur (ROUGE ou BLEU) dim CouleurEnCours as integer ' Couleur du coup en cours dim CouleurOrdi as integer dim QuiCommence as Integer ' ORDI ou JOUEUR dim Gagne as byte ' Quelqu'un a gagné dim CaseH as Integer dim CaseV as Integer dim Alignement as integer dim Coup_Joueur_Ordi as Integer ' coup du joueur = -1 , coup de l'ordi = 1 dim DimGrille as Integer dim Nalign as Integer ' Nombre d'alignements d'une case dim ponderRef as integer ' Pondération de référence minimum pour calcul coup ordi dim PonderCase as integer ' Pondération de la case en cours d'évaluation (calcul coup ordi) dim CaseHCoupJoue as Integer ' Case X du dernier coup joué dim CaseVCoupJoue as Integer ' Case Y dim DernierCoupOrdi$ as string ' Texte du dernier coup joué par l'ordi dim DernierCoupJoueur$ as string ' Texte du dernier coup joué par le joueur dim CoupsJoues as word ' Nombre de coups joués dim a$ as string ' Chaîne générale Ponderation(1) = 1 ' en modifiant ce tableau de pondération, vous pouvez Ponderation(2) = 3 ' modifier la tactique de jeu de l'ordinateur Ponderation(3) = 9 Ponderation(4) = 30 Ponderation(5) = 10000 DimGrille = 10 OrdiJoue= 1 ' Interdit un clic sur la grille QuiCommence = JOUEUR CouleurJoueur = ROUGE CouleurOrdi = BLEU CREATE Fenetre_Principale as Qform ' on crée la fenêtre principale width = 640 height = 475 BorderStyle = 4 create FenetreJeu as Qcanvas ' On crée un grille de 10 x 10 par défaut Top = 70 Left = 200 Width = 202 Height = 202 onpaint = AfficheGrille OnClick = JeuJoueur end create create menu as qmainmenu ' On fabrique le menu Fichier create menu1 as qmenuitem caption = "&Fichier" create menu_CommencePartie as qmenuitem caption = "&Commencer une partie" Onclick = CommencerPartie end create create menu_Inter as qmenuitem caption = "-" end create create menu_Quitter as qmenuitem caption = "&Quitter" onclick = quitter end create end create create menu2 as qmenuitem ' puis le menu des grilles caption = "&Grille" create menu_grille10 as qmenuitem caption = "&10 x 10" onclick = Grille10 checked = VRAI end create create menu_grille15 as qmenuitem caption = "1&5 x 15" onclick = Grille15 end create create menu_grille20 as qmenuitem caption = "&21 x 21" onclick = Grille20 end create end create create menu3 as qmenuitem ' puis le menu des options caption = "&options" create MenuRouge as QmenuItem caption = "Vous jouez avec les &Rouges" Checked = VRAI onclick = PrefereRouge end create create MenuBleu as QmenuItem caption = "Vous jouez avec les &Bleus" onclick = PrefereBleu end create create OptionsInter1 as QmenuItem caption = "-" end create create MenuStartHomme as QmenuItem caption = "Vous commencez" checked = 1 onclick = JoueurCommence end create create MenuStartOrdi as QmenuItem caption = "Je commence" onclick = OrdiCommence end create end create end create create BarreInfos as QstatusBar ' et enfin la barre d'informations SizeGrip = FAUX AddPanels "", "", "","" Panel(0).Width = 260 Panel(1).Width = 110 Panel(2).Width = 135 Panel(0).Alignment = 2 ' Centré end create center showmodal end create '------------------------------------------------------------------------------------------------ sub Grille10 ' grille 10 x 10 Menu_grille10.checked = 1 Menu_grille15.checked = 0 Menu_grille20.checked = 0 FenetreJeu.Top = 70 FenetreJeu.Left = 200 FenetreJeu.Width = 202 FenetreJeu.Height = 202 DimGrille = 10 AfficheGrille end sub '------------------------------------------------------------------------------------------------ sub Grille15 ' grille 15 x 15 Menu_grille10.checked = 0 Menu_grille15.checked = 1 Menu_grille20.checked = 0 FenetreJeu.Top = 25 FenetreJeu.Left = 150 FenetreJeu.Width = 292 FenetreJeu.Height = 292 DimGrille = 15 AfficheGrille end sub '------------------------------------------------------------------------------------------------ sub Grille20 ' grille 21 x 21 Menu_grille10.checked = 0 Menu_grille15.checked = 0 Menu_grille20.checked = 1 FenetreJeu.Top = 0 FenetreJeu.Left = 100 FenetreJeu.Width = 400 FenetreJeu.Height = 400 DimGrille = 21 AfficheGrille end sub '------------------------------------------------------------------------------------------------ sub AfficheGrille ' Affichage de la grille dim i as word Gauche = FenetreJeu.Left Haut = FenetreJeu.Top Largeur = FenetreJeu.Width Hauteur = FenetreJeu.Height fenetrejeu.fillrect = 20,20,Largeur, hauteur, &HC2FEFB NumeroRangee = 0 for i=20 to Largeur step 18 numeroRangee= numeroRangee + 1 ' Pour numéroter les rangées a$=str$(NumeroRangee) ' Numéros verticaux FenetreJeu.TextOut(0, i+5, a$, 0, &HC0C0C0) fenetrejeu.line(20,i,Largeur,i, &H808080) ' Trait horizontal fenetrejeu.line(20,i+1,Largeur,i+1, &H808080) ' ... doublé fenetrejeu.line(i,20,i,hauteur,&H808080) ' Trait vertical fenetrejeu.line(i+1,20,i+1,hauteur,&H808080) ' ... doublé FenetreJeu.Textout(i+5, 5, chr$(NumeroRangee+64), 0, &HC0C0C0) ' Numéros Horizontaux next i FenetreJeu.FillRect(20,19,Largeur,22, &HFFFFFF) ' Bords blancs Haut et gauche FenetreJeu.FillRect(19,20,22,hauteur, &HFFFFFF) FenetreJeu.FillRect(23, hauteur - 2, Largeur,hauteur, 0) FenetreJeu.FillRect(Largeur-2,Hauteur,Largeur, 23, 0) call TextesOrigine end sub '------------------------------------------------------------------------------------------------ sub TextesOrigine BarreInfos.Panel(0).Caption = " French Morpion (version provisoire)" BarreInfos.Panel(1).Caption = " Coups joués : 0 " BarreInfos.Panel(2).Caption = " Votre dernier coup : " BarreInfos.Panel(3).Caption = " Mon dernier coup : " end sub '------------------------------------------------------------------------------------------------ sub PrefereRouge ' Le joueur préfère les rouges MenuRouge.Checked = VRAI MenuBleu.Checked = FAUX CouleurJoueur = ROUGE CouleurOrdi = BLEU end sub '------------------------------------------------------------------------------------------------ sub PrefereBleu ' Le joueur préfère les bleus MenuRouge.Checked = FAUX MenuBleu.Checked = VRAI CouleurJoueur = BLEU CouleurOrdi = ROUGE end sub '------------------------------------------------------------------------------------------------ sub JoueurCommence ' Le joueur choisit de commencer MenuStartHomme.Checked = VRAI MenuStartOrdi.Checked = FAUX QuiCommence = JOUEUR ' 1 : Le joueur commence, 0 : L'ordi commence end sub '------------------------------------------------------------------------------------------------ sub OrdiCommence ' C'est l'ordinateur qui commence MenuStartHomme.Checked = 0 MenuStartOrdi.Checked = 1 QuiCommence = ORDI end sub '------------------------------------------------------------------------------------------------ sub CommencerPartie OrdiJoue = 1 ' cette variable interdit un clic de souris call AfficheGrille ' pendant le jeu de l'ordinateur call InitTableau ' Initialisation du tableau de la grille if QuiCommence = ORDI then ' c'est l'ordi qui commence if CouleurJoueur = ROUGE then CouleurEnCours = BLEU else CouleurEnCours = ROUGE end if JeuOrdi ' c'est l'ordi qui commence else OrdiJoue = 0 CouleurEnCours = CouleurJoueur ' C'est le joueur qui commence end if end sub '------------------------------------------------------------------------------------------------ ' Initialisation des tableaux d'alignements sub InitTableau ' Alignements par case dim nt as integer 'Variable temporaire de NumAlign, puis variable de boucle NumAlign BarreInfos.panel(0).Caption = "Patience... Je me concentre..." for CaseH = 1 to 21 for CaseV = 1 to 21 al(caseV, CaseH, 0) = 0 next CaseV next CaseH FOR CaseH = 1 TO DimGrille ' Alignements horizontaux FOR CaseV = 1 TO DimGrille - 4 NumAlign = (CaseH - 1) * (DimGrille - 4) + CaseV FOR Alignement = 0 TO 4 ' Incrémente le nombre d'alignements de la case al(CaseH, CaseV + Alignement, 0) = al(CaseH, CaseV + Alignement, 0) + 1 al(CaseH, CaseV + Alignement, al(CaseH, CaseV + Alignement, 0)) = NumAlign NEXT Alignement NEXT CaseV NEXT CaseH nt = NumAlign FOR CaseV = 1 TO DimGrille ' alignements verticaux FOR CaseH = 1 TO DimGrille - 4 NumAlign = nt + ((CaseV - 1) * (DimGrille - 4) + CaseH) FOR Alignement = 0 TO 4 al(CaseH + Alignement, CaseV, 0) = al(CaseH + Alignement, CaseV, 0) + 1 al(CaseH + Alignement, CaseV, al(CaseH + Alignement, CaseV, 0)) = NumAlign NEXT Alignement NEXT CaseH NEXT CaseV nt = NumAlign FOR CaseH = 1 TO DimGrille - 4 ' alignements diagonaux 1 FOR CaseV = 1 TO DimGrille - 4 NumAlign = nt + ((CaseH - 1) * (DimGrille - 4) + CaseV) FOR Alignement = 0 TO 4 al(CaseH + Alignement, CaseV + Alignement, 0) = al(CaseH + Alignement, CaseV + Alignement, 0) + 1 al(CaseH + Alignement, CaseV + Alignement, al(CaseH + Alignement, CaseV + Alignement, 0)) = NumAlign NEXT Alignement NEXT CaseV NEXT CaseH nt = NumAlign FOR CaseH = 1 TO DimGrille - 4 ' alignements diagonaux 2 FOR CaseV = 5 TO DimGrille NumAlign = nt + (CaseH - 1) * (DimGrille - 4) + (CaseV - 4) FOR Alignement = 0 TO 4 al(CaseH + Alignement, CaseV - Alignement, 0) = al(CaseH + Alignement, CaseV - Alignement, 0) + 1 al(CaseH + Alignement, CaseV - Alignement, al(CaseH + Alignement, CaseV - Alignement, 0)) = NumAlign NEXT Alignement NEXT CaseV NEXT CaseH for CaseH = 1 to DimGrille ' tableau des coups de l'ordi et du joueur for CaseV = 1 to DimGrille CoupJoueurOrdi(CaseH, CaseV) = 0 next CaseV next CaseH NumAlign = 2 * (21 - 4) * ((2 * 21) - 4) for nt = 1 to Numalign ' note de pondération de chaque alignement à 0 NbrPionsAlign(nt) = 0 next nt CoupsJoues = 0 ' Nombre de coups joués if QuiCommence = JOUEUR then BarreInfos.panel(0).Caption = "A vous..." end if end sub '------------------------------------------------------------------------------------------------ sub JeuOrdi ' Jeu de l'ordinateur BarreInfos.Panel(3).Caption = " Mon dernier coup : " + DernierCoupOrdi$ BarreInfos.Panel(0).Caption = "Je réfléchis ..." OrdiJoue = 1 ' Pour interdire un clic de souris PonderRef = -10000 FOR CaseH = 1 TO DimGrille FOR CaseV = 1 TO DimGrille PonderCase = 0 IF CoupJoueurOrdi(CaseH, CaseV) = 0 THEN ' Si cette case n'a jamais été jouée Nalign = al(CaseH, CaseV, 0) FOR Alignement = 1 TO Nalign NumAlign = al(CaseH, CaseV, Alignement) IF NbrPionsAlign(NumAlign) <> 9999 THEN ' Si pas de pions des 2 joueurs dans l'alignement IF NbrPionsAlign(NumAlign) >= 0 THEN ' S'il y a des pions de l'ordi PonderCase = PonderCase + Ponderation(NbrPionsAlign(NumAlign) + 1) ' Met à jour la pondération de cette case pour chaque alignement ELSE ' Sinon, ce sont des pions du joueur PonderCase = PonderCase + Ponderation(1 - NbrPionsAlign(NumAlign)) ' Met à jour la pondération END IF END IF NEXT Alignement IF PonderCase > PonderRef THEN CaseHCoupJoue = CaseH CaseVCoupJoue = CaseV PonderRef = PonderCase END IF END IF NEXT CaseV NEXT CaseH Coup_Joueur_Ordi = 1 CalculScores CouleurEnCours = CouleurOrdi AfficheCoup if gagne then ' Si l'ordinateur a gagné OrdiJoue = 2 call JaiGagne else OrdiJoue = 0 ' Autorise le clic sur la grille DernierCoupOrdi$ = chr$(CaseHCoupJoue + 64) + " - " + str$(CaseVCoupJoue) BarreInfos.Panel(0).Caption = " Je joue en " + DernierCoupOrdi$ + " A vous..." end if end sub '------------------------------------------------------------------------------------------------ sub JeuJoueur if OrdiJoue > 0 then ' Ne pas tenir compte de ce clic non autorisé exit sub end if CaseHCoupJoue = (MouseX - 12) / 18 CaseVCoupJoue = (MouseY - 12) / 18 if CaseHCoupJoue = 0 or CaseVCoupJoue = 0 then ' Clic en dehors de la grille exit sub end if DernierCoupJoueur$ = chr$(CaseHCoupJoue + 64) + " - " + str$(CaseVCoupJoue) BarreInfos.Panel(2).Caption = " Votre dernier coup : " + DernierCoupJoueur$ CouleurEnCours = CouleurJoueur Coup_Joueur_Ordi = -1 call CalculScores call AfficheCoup if gagne then 'le joueur a gagné call JaiGagne else call JeuOrdi end if end sub '------------------------------------------------------------------------------------------------ sub CalculScores ' Calcul et mise à jour des scores Nalign = al(CaseHCoupJoue, CaseVCoupJoue, 0) FOR Alignement = 1 TO Nalign NumAlign = al(CaseHCoupJoue, CaseVCoupJoue, Alignement) IF NbrPionsAlign(NumAlign) <> 9999 THEN IF NbrPionsAlign(NumAlign) * Coup_Joueur_Ordi < 0 THEN NbrPionsAlign(NumAlign) = 9999 else NbrPionsAlign(NumAlign) = NbrPionsAlign(NumAlign) + Coup_Joueur_Ordi Gagne = (abs(NbrPionsAlign(NumAlign)) = 5) end if end if if gagne then exit for end if NEXT Alignement CoupJoueurOrdi(CaseHCoupJoue, CaseVCoupJoue) = Coup_Joueur_Ordi inc CoupsJoues BarreInfos.Panel(1).Caption = " Coups joués : " + str$(CoupsJoues) end sub '------------------------------------------------------------------------------------------------ sub AfficheCoup ' Affiche le coup joué AfficheCoupX = 5+(18*CaseHCoupJoue) AfficheCoupY = 6+(18*CaseVCoupJoue) fenetrejeu.line(AfficheCoupX, AfficheCoupY,AfficheCoupX + 13, AfficheCoupY + 13, CouleurEnCours) fenetrejeu.line(AfficheCoupX, AfficheCoupY + 1,AfficheCoupX + 12, AfficheCoupY + 13, CouleurEnCours) fenetrejeu.line(AfficheCoupX + 1, AfficheCoupY,AfficheCoupX + 13, AfficheCoupY + 12, CouleurEnCours) fenetrejeu.line(AfficheCoupX + 13, AfficheCoupY,AfficheCoupX, AfficheCoupY + 13, CouleurEnCours) fenetrejeu.line(AfficheCoupX + 12, AfficheCoupY,AfficheCoupX, AfficheCoupY + 12, CouleurEnCours) fenetrejeu.line(AfficheCoupX + 13, AfficheCoupY + 1,AfficheCoupX + 1, AfficheCoupY + 13, CouleurEnCours) end sub '------------------------------------------------------------------------------------------------ sub JaiGagne ' L'un des 2 joueurs a gagné dim Couleur as integer OrdiJoue = 1 ' Plus de clic autorisé dans la grille if Coup_Joueur_Ordi = -1 then BarreInfos.Panel(0).Caption = "Vous avez gagné en " + str$(CoupsJoues) + " coups." else BarreInfos.Panel(0).Caption = "J'ai gagné en " + str$(CoupsJoues) + " coups." end if couleur = CouleurEnCours for gagne = 1 to 10 CouleurEnCours = Couleur call AfficheCoup sleep 0.5 CouleurEnCours = &HC2FEFB call AfficheCoup sleep 0.5 next gagne end sub sub Quitter ' Option Quitter du menu Fenetre_Principale.Close end sub