Un petit jeu moin simple qu'il en a l'air

Programmation avancée de jeux en PureBasic
Avatar de l’utilisateur
MLD
Messages : 1097
Inscription : jeu. 05/févr./2009 17:58
Localisation : Bretagne

Un petit jeu moin simple qu'il en a l'air

Message par MLD »

Bonjour a tous
Un petit jeu de Pousse-pousse.
Amusez vous bien.

Code : Tout sélectionner

;¤¤¤ Jeu Pousse-pousse MLD 26/04/2020: Droits libre. ¤¤¤¤¤
;¤¤¤ Compilation PB 5.72 X86                         ¤¤¤¤¤ 
#Fp = 1:#contner = 2:#txtinfo = 3
#txtP1 = 10:#txtP2 = 11:#txtP3 = 12:#txtP4 = 13:#txtP5 = 14:#txtP6 = 15:#txtP7 = 16:#txtP8 = 17:#txtP9 = 18:#txtP10 = 19
#txtP11 = 20:#txtP12 = 21:#txtP13 = 22:#txtP14 = 23:#txtP15 = 24:#txtP16 = 25:#txtP17 = 26:#txtP18 = 27:#txtP19 = 28:#txtP20 = 29
#txtP21 = 30:#txtP22 = 31:#txtP23 = 32:#txtP24 = 33:#txtP25 = 34:#txtP26 = 35:#txtP27 = 36:#txtP28 = 37
#txtbtinf = 40:#txtbtscr = 41:#txtbtnj = 42:#txtbtstop = 43:#txtchronos = 44:#txttemps = 45
#tim1 = 100:#fchscor = 110
#Fj= 60:#txttitre = 61:#txtnom = 62:#stringn = 63:#btjeu = 64:#btraz = 65:#btretour = 66:#editor = 67:#list = 68

Global FontID2 = LoadFont(301,"Comic sans MS",14,#PB_Font_Italic)
Global FontID3 = LoadFont(302,"Comic sans MS",12,#PB_Font_Italic)
Global FontID4 = LoadFont(303,"Arial",12)
Global dpj = 0, nj$

Macro Coul(g,coulf,coult)
SetGadgetColor(g,#PB_Gadget_BackColor,coulf):SetGadgetColor(g,#PB_Gadget_FrontColor,coult) 
EndMacro

Procedure prereq();init
  Global  X =0,Y = 0,larg = 100,haut = 100,ngcd =10,ngcm = 37,nbchz = 7,nbcv = 4,fc = 65,hl = 70
EndProcedure

Procedure Forme() 
  Region = CreateRoundRectRgn_(1, 0, WindowWidth(1), WindowHeight(1), 40, 60) 
  SetWindowRgn_(WindowID(1), Region,1):DeleteObject_(Region)  
EndProcedure

Procedure WindowCallback(WindowID,message,wParam,lParam)
  res=#PB_ProcessPureBasicEvents
  Select message 
    Case #WM_PAINT
      Forme() 
  EndSelect
  ProcedureReturn res
EndProcedure

Procedure affc()
  Global Dim Tposcor((ngcm -ngcd)+1,3)
  Global Dim Tposc((ngcm -ngcd)+1,4)
  Global FontID1 = LoadFont(300,"Arial",hl)
  lig = 0
  For z = ngcd To (ngcm - ngcd)+9 
    lig = lig + 1
    If lig = nbchz +1:Y = Y + haut +1:X = 0:lig = 1:EndIf 
    Tposcor(z-9,1)= z:Tposcor(z-9,2)= X:Tposcor(z-9,3)= Y
    If z = 36 :fc = 33:EndIf 
    Tposc(z-9,1)= z:Tposc(z-9,2)= X:Tposc(z-9,3)= Y:Tposc(z-9,4)= fc
    X =X +larg +1 :fc = fc +1 
  Next
  TextGadget(z,X,Y,larg,haut,"")
  Coul(z,$00A5FF,$0) 
  For c = 1 To (ngcm - ngcd)
   TextGadget(Tposc(c,1),Tposc(c,2),Tposc(c,3),larg,haut,"",#PB_Text_Center|#SS_CENTERIMAGE | #WS_DLGFRAME|#SS_NOTIFY)
   SetGadgetFont(Tposc(c,1),FontID1):Coul(Tposc(c,1),$0B86B8,$FF0000)
  Next
EndProcedure

Procedure brasse()
 If dpj = 1 
  For i = (ngcm - ngcd) To 1  Step-1
   irnd = Random(27,1)
   Swap Tposc(i,1),Tposc(irnd,1)
   Swap Tposc(i,4),Tposc(irnd,4)
 Next
 EndIf
 For zz = 1 To (ngcm - ngcd)
   ResizeGadget(Tposc(zz,1),Tposc(zz,2),Tposc(zz,3),#PB_Ignore,#PB_Ignore)
   SetGadgetText(Tposc(zz,1),Chr(Tposc(zz,4)))
 Next  
EndProcedure

Procedure Gscor(fj)
  l = 0
  Global Dim Tsc.s(0)
  OpenFile(110, GetTemporaryDirectory() + "PPscor")
  While Eof(110) = 0 
    l = l + 1:ReDim Tsc.s(l)
    Tsc.s(l) = ReadString(110) 
  Wend
  CloseFile(110)
  SortArray(Tsc.s(),#PB_Sort_NoCase)
  If fj = 1
    SetGadgetText(3,"Bravo! " + " Champion actuel " + StringField(Tsc.s(1),2,"*") + " " +StringField(Tsc.s(1),1,"*"))
  EndIf  
EndProcedure  

Procedure control()
  pt = 0
  For zz = ngcd To ngcm
    If GadgetX(zz) = Tposcor(zz-9,2) And GadgetY(zz) = Tposcor(zz-9,3)
      pt = pt + 1 
    Else
      Break
    EndIf
  Next
  If pt = (ngcm -ngcd)
   dpj = 0
   enrsc$ = GetGadgetText(45) + " " + "*" + nj$  + "*" + "  le " + FormatDate("%dd/%mm/%YYYY",Date())+ "*"
   OpenFile(110, GetTemporaryDirectory() + "PPscor")
    FileSeek(110, Lof(110)):WriteStringN(110,enrsc$)
   CloseFile(110)
   Gscor(1)
  EndIf
EndProcedure 

Procedure chrono()
 Static s,m,h
 s +1
 If s > 59:s = 0:m = m + 1:EndIf
 If m > 59:m = 0:h = h + 1:EndIf
 If h > 24:h = 0:EndIf
 If dpj = 0:s=0:m = 0:h = 0:EndIf
 If h < 10: h$ = "0" + Str(h):Else:h$ = Str(h):EndIf 
 If m < 10: m$ = "0" + Str(m):Else:m$ = Str(m):EndIf 
 If s < 10: s$ = "0" + Str(s):Else:s$ = Str(s):EndIf 
 SetGadgetText(45,"h " + h$ +" m "+ m$ + " s "+ s$)
EndProcedure 

Procedure nj(n)
 StickyWindow(1,0)   
 OpenWindow(60,WindowX(1)+ ((WindowWidth(1)- 350)/2),WindowY(1)+ ((WindowHeight(1)- 350)/2),350,180,"",#PB_Window_BorderLess|#NUL)
 SetWindowColor(60,$AFB74C)
 SetWindowLongPtr_(WindowID(60),#GWL_HWNDPARENT,FindWindow_(0,"program manager"))
 SetWindowLongPtr_(WindowID(60), #GWL_STYLE, GetWindowLongPtr_(WindowID(60), #GWL_STYLE) | #WS_DLGFRAME)
 SetWindowPos_(WindowID(60), 0,0,0,0,0,#SWP_NOSIZE|#SWP_NOMOVE|#SWP_NOZORDER|#SWP_FRAMECHANGED)
 StickyWindow(60,1)
 TextGadget(61,10,10,325,27,"",#PB_Text_Center);titre
 SetGadgetFont(61,FontID2):Coul(61,$AFB74C,$00FFFF)
 ButtonGadget(66,260,145,80,25,"Retour")
 If n =1
   SetGadgetText(61,"Nouveau jeu")
   TextGadget(62,40,60,70,27,"Joueur:")
   SetGadgetFont(62,FontID2):Coul(62,$AFB74C,$CD0000)
   StringGadget(63,130,60,180,30,nj$)
   SetGadgetFont(63,FontID2):Coul(63,$AFB74C,$CD0000):SetActiveGadget(63)
   SetGadgetAttribute(63,#PB_String_MaximumLength,9)
   ButtonGadget(64,179,145,80,25,"Lance le Jeu")
 EndIf
 If n = 2
   SetGadgetText(61,"Scores")
   ListViewGadget(68,10,40,325,100)
   SetGadgetFont(68,FontID4):Coul(68,$008000,$FFFFFF)
   For tb = 1 To ArraySize(Tsc.s())
    AddGadgetItem(68,-1,RemoveString(Tsc.s(tb),"*"))
   Next  
 EndIf  
 If n =3
   SetGadgetText(61,"Informations")
   EditorGadget(67,20,40,305,100,#PB_Editor_ReadOnly|#PB_Editor_WordWrap)
   Coul(67,$008000,$FFFFFF)
   a1$ = "Bonjour" + #CRLF$ + "Ce jeu connu sous le nom de Pousse-pousse, consiste a remettre l'alphabet dans l'ordre."  + #CRLF$
   a2$ = "Un clique de souris déplace la case en lieu et place de la case vide." + #CRLF$ + "Le plus rapide est le champion."
   AddGadgetItem(67,-1, a1$ + a2$)
 EndIf  
 EndProcedure
 
hwnd= OpenWindow(1,0,0,806,503,"x",#PB_Window_BorderLess | #PB_Window_ScreenCentered)
SetWindowCallback(@WindowCallback())
StickyWindow(1,1)
SetWindowColor(1,$00A5FF)
prereq()
ContainerGadget(2,(WindowWidth(1)-706)/2,(WindowHeight(1)-403)/2,706,403,#PB_Container_Double)
SetGadgetColor(2,#PB_Gadget_BackColor,$1E69D2)
affc()
CloseGadgetList() 
brasse()
TextGadget(3,330,467,430,27,"",#PB_Text_Center)
SetGadgetFont(3,FontID3):Coul(3,$00A5FF,$008000)
TextGadget(40,100,10,125,27, "Informations",#SS_NOTIFY)
SetGadgetFont(40,FontID2):Coul(40,$00A5FF,$0)
TextGadget(41,310,10,100,27, "Scores",#SS_NOTIFY)
SetGadgetFont(41,FontID2):Coul(41,$00A5FF,$0)
TextGadget(42,460,10,140,27, "Nouveau jeu",#SS_NOTIFY)
SetGadgetFont(42,FontID2):Coul(42,$00A5FF,$0)
TextGadget(43,660,10,100,27, "Stop",#SS_NOTIFY)
SetGadgetFont(43,FontID2):Coul(43,$00A5FF,$0)
TextGadget(44,50,465,120,27,"Chronomètre")
SetGadgetFont(44,FontID2):Coul(44,$00A5FF,$1EDBFF)
SetGadgetFont(43,FontID2):Coul(43,$00A5FF,$0)
TextGadget(45,180,465,150,27,"")
SetGadgetFont(45,FontID2):Coul(45,$00A5FF,$1EDBFF)
AddWindowTimer(1,100,1)
Gscor(0)
Repeat
  Evenement =  WindowEvent()
  If dpj = 1
   ms = ElapsedMilliseconds() - tref
   If ms > 999:ms = 0:tref = ElapsedMilliseconds(): s = s + 1:chrono():EndIf
 EndIf 
  If Evenement  = #PB_Event_Timer And EventTimer() = 100
   cvx = GadgetX(ngcm):cvy = GadgetY(ngcm)
  EndIf 
  Select EventWindow() 
   Case 1
     If GetActiveWindow() <> 60
      If  Evenement = #WM_LBUTTONDOWN
        SendMessage_(WindowID(1), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
      EndIf  
     EndIf    
     If Evenement = #PB_Event_Gadget
      Select EventGadget() 
       Case 10 To ngcm -1
        If dpj = 1 ;****** a virer pour teste   
         top = 0
         cx = GadgetX(EventGadget()) 
         cy = GadgetY(EventGadget())
         If cvx - cx =101 And cvy - cy = 0:top =1:EndIf
         If cvx - cx = -101 And cvy - cy = 0:top =1:EndIf
         If cvx - cx = 0 And cvy - cy = 101:top =1:EndIf
         If cvx - cx = 0 And cvy - cy = -101:top =1:EndIf
         If top = 1
          Swap cvx,cx:Swap cvy,cy
          ResizeGadget(ngcm,cvx,cvy,#PB_Ignore,#PB_Ignore)
          ResizeGadget(EventGadget(),cx,cy,#PB_Ignore,#PB_Ignore)
         EndIf
          control()
     EndIf
   Case 40 ;infos
       nj(3)
   Case 41 ;scores
       nj(2) 
   Case 42;nj  
       dpj = 0:SetGadgetText(3,""):chrono():nj(1)
   Case 43
       Evenement = #PB_Event_CloseWindow ; On quitte
       Break
     EndSelect 
    EndIf
   Case 60;2emf 
       If Evenement = #PB_Event_Gadget
         Select EventGadget()
         Case 64
           dpj = 1:brasse()
           If GetGadgetText(63)<> ""
            nj$ = GetGadgetText(63)
           Else
            nj$ = "Anonyme"
          EndIf
          SetGadgetText(63,nj$)
          CloseWindow(60)
          StickyWindow(1,1)  
         Case 66
          CloseWindow(60)
          StickyWindow(1,1)   
        EndSelect 
      EndIf      
   EndSelect
 ForEver
 FreeArray(Tposcor()):FreeArray(Tposc()):FreeArray(Tsc.s())
End         
Dernière modification par MLD le mar. 05/mai/2020 12:34, modifié 2 fois.
Avatar de l’utilisateur
Ar-S
Messages : 9472
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Un petit jeu moin simple qu'il en a l'air

Message par Ar-S »

Très sympa merci :)
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Avatar de l’utilisateur
Guillot
Messages : 521
Inscription : jeu. 25/juin/2015 16:18

Re: Un petit jeu moin simple qu'il en a l'air

Message par Guillot »

19 minutes !

250 lignes, chapeau
un petit bug, le fichier des scores doit être creer si absent
Avatar de l’utilisateur
venom
Messages : 3071
Inscription : jeu. 29/juil./2004 16:33
Localisation : Klyntar
Contact :

Re: Un petit jeu moin simple qu'il en a l'air

Message par venom »

8) Excellent. Merci du partage MLD. J'en avais commencer un il y a quelques années. :D Comme beaucoup de projets, j'ai laissé de coté :lol:






@++
Windows 10 x64, PureBasic 5.73 x86 & x64
GPU : radeon HD6370M, CPU : p6200 2.13Ghz
Avatar de l’utilisateur
MLD
Messages : 1097
Inscription : jeu. 05/févr./2009 17:58
Localisation : Bretagne

Re: Un petit jeu moin simple qu'il en a l'air

Message par MLD »

Merci les amis
Guillot a écrit :un petit bug, le fichier des scores doit être creer si absent
Stp tu peu me dire dans quel condition tu as le bug. Merci 8O
Je doit aussi te donner un coup de chapeau pour tes productions d'images en mouvement. :wink:
Avatar de l’utilisateur
Guillot
Messages : 521
Inscription : jeu. 25/juin/2015 16:18

Re: Un petit jeu moin simple qu'il en a l'air

Message par Guillot »

au démarrage du pg
ligne 77 (While Eof(110) = 0)
"le #file specifié n'est pas initialisé"

dans les options du compilateur j'ai aucun dossier spécifié dans "répértoire courant"
peut etre que la creation de fichier est interdite dans le dossier ou le code est executé
je suis pas trop calé dans le domaine

essais de faire un copier-coller de ton code et de l'executer
Avatar de l’utilisateur
venom
Messages : 3071
Inscription : jeu. 29/juil./2004 16:33
Localisation : Klyntar
Contact :

Re: Un petit jeu moin simple qu'il en a l'air

Message par venom »

@guillot

J'ai eu la même erreur. J'ai juste compiler en x86 et ça a fonctionné :lol: Aucun rapport pourtant :roll:






@++
Dernière modification par venom le mar. 28/avr./2020 17:12, modifié 1 fois.
Windows 10 x64, PureBasic 5.73 x86 & x64
GPU : radeon HD6370M, CPU : p6200 2.13Ghz
Marc56
Messages : 2145
Inscription : sam. 08/févr./2014 15:19

Re: Un petit jeu moin simple qu'il en a l'air

Message par Marc56 »

C'est effectivement comme souvent l'écriture de fichier temporaire (score) qui se fait dans le répertoire en cours qui n'est pas toujours le répertoire de lancement.
Une bonne habitude est de préfixer par GetTemporaryDirectory() ou un des répertoires de l'utilisateur (voir GetUserDirectory())

Code : Tout sélectionner

  OpenFile(110,GetTemporaryDirectory() + "PPscor")
  While Eof(110) = 0
:wink:
Avatar de l’utilisateur
MLD
Messages : 1097
Inscription : jeu. 05/févr./2009 17:58
Localisation : Bretagne

Re: Un petit jeu moin simple qu'il en a l'air

Message par MLD »

Merci de vos réponses

@Guillot
Ce n'est pas le problème. Pour ton information je fait un copier coller du programme qui fonctionne sur mon ordi pour inclure dans le forum. :lol: :wink:

@venom
Oui je compile en X86, mais je ne pense pas que le problème est a ce niveau. :wink:

@ Marc56
Bien entendu je connais GetTemporaryDirectory() , mais théoriquement d'aprés la doc PB ce n'est pas utile car le fichier est automatiquement créer dans le répertoire courant.
Ceci fait un peu ceinture et bretelles. :oops: Mais même si sur mon ordi, je n'est jamais eu ce bug, a partir du moment ou certains ont eu le problème il ne faut pas hésiter.
J'ai donc modifié la ligne 77 dans le poste 1. :oops: :lol:
Un essais de votre part serai sympa, et aurais ma reconnaissance éternel.
Bonne soirée a tous
Michel
Avatar de l’utilisateur
kernadec
Messages : 1594
Inscription : ven. 25/avr./2008 11:14

Re: Un petit jeu moin simple qu'il en a l'air

Message par kernadec »

bjr MLD
Meric pour le partage, très sympa :D
j 'une idée pour développer ce style de jeu tu pourrais stocker une banque
d'image en pressant sur une case mode toggle avec la molette en faire defiller
une centaine par case au choix pour faire un jeu de rebus pour le enfants..
c 'est à la mode sur la chaine l'équipe enfin voilà c 'est juste une idée de ouf :mrgreen:
Cordialement
Avatar de l’utilisateur
venom
Messages : 3071
Inscription : jeu. 29/juil./2004 16:33
Localisation : Klyntar
Contact :

Re: Un petit jeu moin simple qu'il en a l'air

Message par venom »

L'erreur ne se produit plus chez moi en x64 :wink:






@++
Windows 10 x64, PureBasic 5.73 x86 & x64
GPU : radeon HD6370M, CPU : p6200 2.13Ghz
Marc56
Messages : 2145
Inscription : sam. 08/févr./2014 15:19

Re: Un petit jeu moin simple qu'il en a l'air

Message par Marc56 »

théoriquement d'aprés la doc PB ce n'est pas utile car le fichier est automatiquement créé dans le répertoire courant.
:!: Oui, mais on oublie souvent que le répertoire "courant" n'est pas nécessairement le répertoire où l'application se lance. Le système (Win ou Linux) ne fait pas un "CD <rep>" avant de lancer un programme. C'est l'OS qui gère car il travaille en interne avec le chemin complet.

Vérification: Lancer ceci dans l'IDE. Si ce dernier a été lancé depuis un raccourci ou un launcher, GetCurrentDirectory() ne donnera pas nécessairement le chemin qui correspond à l'EXE lui-même

Code : Tout sélectionner

; Le répertoire où le système pointe actuellement
Debug GetCurrentDirectory()

; Le nom du programme actuel
Debug ProgramFilename()

; Aller dans le répertoire du programme actuel
SetCurrentDirectory( GetPathPart( ProgramFilename() ) )

; Le nouveau répertoire actuel
Debug GetCurrentDirectory()
Si on veut forcer le répertoire en cours à celui du programme, ajouter au début du code.

Code : Tout sélectionner

SetCurrentDirectory( GetPathPart( ProgramFilename() ) )
et ne pas oublier qu'un SaveFileRequester peut aussi changer ce répertoire "en cours"

:idea: Le plus sûr est donc d'utiliser les variables utilisateurs avec GetUserDirectory() sauf quand on veut faire des programmes à utiliser en mode portable.
De plus, depuis XP, les répertoires %Windir%, %ProgramFiles% et la racine du disque système ne sont pas accessibles en écriture pour les comptes non-admin.

PS. Oui, ton programme fonctionne bien en x64 :wink:
Avatar de l’utilisateur
MLD
Messages : 1097
Inscription : jeu. 05/févr./2009 17:58
Localisation : Bretagne

Re: Un petit jeu moin simple qu'il en a l'air

Message par MLD »

Je ne comprend pas pourquoi l'erreur ce produit en compilation 32 bits et pas en 64 :?:
Perso je n'est jamais eu cette erreur . J'ai windows 10 en 64 bits et je compile en 32.
Ce n'est pas la première fois que je programme des fichiers comme cela, et je n'est pas eu problème. Mais c'est la première fois avec PB 5.72.
Le loup est peu être cacher ici. :roll: :oops:
Marc56
Messages : 2145
Inscription : sam. 08/févr./2014 15:19

Re: Un petit jeu moin simple qu'il en a l'air

Message par Marc56 »

MLD a écrit :Je ne comprend pas pourquoi l'erreur ce produit en compilation 32 bits et pas en 64 :?:
Quand tu lances un programme x86 sur un Windows x64, Windows le rend compatible en le faisant tourner dans un "program file" virtuel (Virtual Store)
Ex:
"C:\<utilisateurs>\<Nom utilisateur>\AppData\Virtual Store\"
Pour assurer la (mauvaise) compatibilité, dont le fait de pouvoir écrire dans le répertoire programfile

Cherches ton fichier "ppscor", tu le trouvera là si tu compiles en x86 et en erreur si tu compile en x86 (sans la modification)

:wink:
Avatar de l’utilisateur
Guillot
Messages : 521
Inscription : jeu. 25/juin/2015 16:18

Re: Un petit jeu moin simple qu'il en a l'air

Message par Guillot »

ouai, c'est ok
mais le dossier temporaire n'est pas approprié pour les high score, c'est super important !!! ;o)
Répondre