PureBasic

Forums PureBasic
Nous sommes le Ven 13/Déc/2019 14:46

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 26 messages ]  Aller à la page 1, 2  Suivante
Auteur Message
 Sujet du message: Candy
MessagePosté: Jeu 10/Nov/2016 9:48 
Hors ligne
Avatar de l’utilisateur

Inscription: Mar 31/Mai/2016 9:06
Messages: 2113
voici donc suite au post de Blendman, une version d'un prg style Candy crush

Image

au demarrage, le tableau s'initialise

le bouton "initialisation" sert a relancer une generation de tableau

pour jouer, il suffit de chercher a faire des allignements de couleurs de 3 dalles , en verticale ou horizontale
en cliquant sur une dalle , ça echange avec son voisin du dessus

il se peux que plusieurs dalles finissent par s'aligner et creer de nouveaux allignements
ce qui augmente le nombre de points (effet boule de neige )

un clique qui ne donne rien, fait perdre des points

Code:
;***********************************************
;Titre  :*candy_crush_test
;Auteur  : Zorro
;Date  :09/11/2016
;Heure  :19:52:40
;Version Purebasic :  PureBasic 5.50 (Windows - x64)
;Version de l'editeur :EPB V2.64
; Libairies necessaire : Aucune
;***********************************************
;
Declare creation_map()
Declare  echange_vertical(Lx,Ly)
Declare echange_Horizontal(Lx,Ly)
Declare dessin()
Declare open_window()
Declare supr_horizontal()
Declare supr_vertical()
Declare supr_noirs()
Declare generation_premiere_ligne()
Declare windowcallback(windowid, message, wparam, lparam)


Enumeration
      #Win ; numero de la fenetre
      #Button_init ; numero du bouton      
      #Titre
      #fonte_titre
      #Auteur
      #Score
      #T_Score
      #titre_up
      #Vert
      #Horiz
      #Container
EndEnumeration
Enumeration
      #image_noir
      #image_rouge
      #image_vert
      #image_bleu
      #image_jaune
EndEnumeration
InitMouse()
if InitSprite()=0
      MessageRequester("erreur","pas pu initialiser les sprites")
      End
Endif
Global x_larg=640
Global y_haut=384
Global Flag=#False
GLobal Score.i =250
Global Flag_start
Global flag_touche=1
Open_Window() ; appel de la procedure qui ouvre la fenetre

; ****** creation des sprites *********
; couleurs
noir=rgb(0,0,0);0
rouge=rgb(255,0,0) ;1
vert=rgb(0,255,0);2
bleu=rgb(0,0,255);3
jaune=rgb(255,255,0);4
Createimage(#image_noir,32,32) ; creation d'une cellule vide (un sprite)
StartDrawing( imageOutput(#image_noir)) ; on va dessiner dans notre sprite un carre coloré
      Box(1,1,32,32,noir)
StopDrawing()
Createimage(#image_rouge,32,32) ; creation d'une cellule vide (un sprite)
StartDrawing( imageOutput(#image_rouge)) ; on va dessiner dans notre sprite un carre coloré
      Box(1,1,32,32,rouge)
StopDrawing()
Createimage(#image_vert,32,32) ; creation d'une cellule vide (un sprite)
StartDrawing( imageOutput(#image_vert)) ; on va dessiner dans notre sprite un carre coloré
      Box(1,1,32,32,vert)
StopDrawing()
Createimage(#image_bleu,32,32) ; creation d'une cellule vide (un sprite)
StartDrawing( imageOutput(#image_bleu)) ; on va dessiner dans notre sprite un carre coloré
      Box(1,1,32,32,bleu)
StopDrawing()
Createimage(#image_jaune,32,32) ; creation d'une cellule vide (un sprite)
StartDrawing( imageOutput(#image_jaune)) ; on va dessiner dans notre sprite un carre coloré
      Box(1,1,32,32,jaune)
StopDrawing()
; random
Global Dim Ligne$(15)
;**************************************


Creation_map()



Repeat ; boucle principale , qui gere les affichages dans l'ecran graphique et les evenement de la fenetre
      event=WaitWindowEvent(5) ; attends de recevoir un evenements de la fenetre
      WindowID = EventWindow() ;   
      EventType = EventType() ;
      select  event
            ; ********************************* regarde les evenements de gadget ***************************
      Case #PB_Event_Gadget
            Select EventGadget()
            Case #Button_init ; on a appuyé sur le bouton..!!
                  Creation_map()
                  Case #vert
                  
                  Case #horiz
            EndSelect
            
      Case  #PB_Event_CloseWindow
            End
      Endselect
      ; ****************************************************************************
      supr_horizontal()
      supr_vertical()
      supr_noirs()
      generation_premiere_ligne()
      
      ;***************************************
      ; *****************************************
Forever
End

;- Zone Procedures
Procedure Open_Window()
      ;-Open_Window()
      If OpenWindow(#Win, 20, 50, 640,  600, "Candy",  #PB_Window_SystemMenu |  #PB_Window_TitleBar ) ; on ouvre une fenetre
            SmartWindowRefresh(#Win, #true)
            TextGadget(#Titre, 250, 10, 100, 30, "Candy",#PB_Text_Center)
            If LoadFont(#fonte_titre, "Arial", 24)
                  SetGadgetFont(#Titre, FontID(#fonte_titre))   ; la police par défaut est remplacée par celle chargée (Arial 16)
            EndIf
            TextGadget(#Auteur, 350, 30, 100, 20, "By Zorro",#PB_Text_Center)
            
            TextGadget(#T_Score, 10, 50, 50, 20, "Score :",#PB_Text_Center)
            TextGadget(#Score, 60, 50, 100, 20, "0000",#PB_Text_Center)
            
            OpenWindowedScreen(windowID(#Win), 1, 100, x_larg, y_haut, 0, 1, 1) ; on creer un ecran graphique dedans
            ButtonGadget(#Button_init, 30, 500, 100, 30, "Reinitialisation")  ; on suprime les series de 3 horizontal et on compress
            
            ContainerGadget(#Container, 160, 500,170, 50,#PB_Container_Single)             
            OptionGadget(#Vert, 1, 1, 160, 20, "^ echange vertical")
            OptionGadget(#Horiz, 1, 30, 160, 20, "<> echange horizontal")
            SetGadgetState(#Vert, #true)
            CloseGadgetList()
            
            SetWindowCallback(@WindowCallback())
      EndIf
EndProcedure
;
Procedure Creation_map()
      ;- creaton tableau()
      Flag_start=#true
      RandomSeed(ElapsedMilliseconds())      
      For y=1 to 12
            ligne$(y)=""
      Next y
      For y=1 to  12
            For x=1 to 20
                  de=random(4,0)                  
                  ligne$(y)=ligne$(y)+str(de)
            Next x
      Next y      
      dessin() ; dessin du tableau
EndProcedure

Procedure echange_vertical(Lx,Ly)
      ;- echange Vertical de dalle()
      If Ly>1
            car_bas$=mid(ligne$(Ly),Lx,1)
            car_haut$=mid(ligne$(Ly-1),Lx,1)
            replacestring( ligne$(ly),car_bas$,car_haut$ ,#PB_String_InPlace,Lx,1)
            replacestring( ligne$(ly-1),car_haut$,car_bas$ ,#PB_String_InPlace,Lx,1)
      Endif
EndProcedure

Procedure echange_Horizontal(Lx,Ly)
      ;- echange Horizontal de dalle()
      If Lx<20
            car_bas$=mid(ligne$(Ly),Lx,1)
            car_droit$=mid(ligne$(Ly),Lx+1,1)
            replacestring( ligne$(ly),car_bas$,car_droit$ ,#PB_String_InPlace,Lx,1)
            replacestring( ligne$(ly),car_droit$,car_bas$ ,#PB_String_InPlace,Lx+1,1)
   Endif
EndProcedure




Procedure dessin()
      ;-Dessin()
      StartDrawing(ScreenOutput())
            For y=1 to  12
                  For x=1 to 20
                        nbr$=Mid(ligne$(y),x,1)
                        DrawImage(imageId(val(nbr$)),xj,yj)
                        xj=xj+32
                  Next x
                  xj=0
                  yj=yj+32
            Next y
      StopDrawing()
      FlipBuffers() ; execute l'affichage
      If Flag_start=#false
            SetGadgetText(#Score, str(score.i))
      Endif
EndProcedure



Procedure supr_horizontal()
      ;- supr_horizontal
      ; test horizontale verifie si 3 images semblable se suivent
      ; si c'est le cas on remplace par des case noires (0)
      For i=1 to 12 ; pour chaque lignes
            If FindString(ligne$(i),"111")
                  ligne$(i)=ReplaceString(ligne$(i),"111","000")
                  if Flag_start=#false
                        Score.i=Score.i+3
                  Endif
            Endif
            If FindString(ligne$(i),"222")
                  ligne$(i)=ReplaceString(ligne$(i),"222","000")
                  if Flag_start=#false
                        Score.i=Score.i+3
                  Endif
            Endif
            If FindString(ligne$(i),"333")
                  ligne$(i)=ReplaceString(ligne$(i),"333","000")
                  if Flag_start=#false
                        Score.i=Score.i+3
                  Endif
            Endif
            If FindString(ligne$(i),"444")
                  ligne$(i)=ReplaceString(ligne$(i),"444","000")
                  if Flag_start=#false
                        Score.i=Score.i+3
                  Endif
            Endif
      Next i
      dessin()
EndProcedure

Procedure supr_vertical()
      ;- supr_Vertical
      For x=1 to 20
            For y=1 to 12
                  car1$=mid(ligne$(y),x,1)
                  car2$=mid(ligne$(y+1),x,1)
                  car3$=mid(ligne$(y+2),x,1)
                  
                  If car1$<>"0"
                        If car3$=car2$ and car3$=car1$                        
                              replacestring( ligne$(y),car1$,"0",#PB_String_InPlace,x,1)
                              replacestring( ligne$(y+1),car2$,"0",#PB_String_InPlace,x,1)
                              replacestring( ligne$(y+2),car3$,"0" ,#PB_String_InPlace,x,1)
                              if Flag_start=#false
                                    Score.i=Score.i+3
                              Endif
                        Endif
                  Endif
                  
            Next y
      Next x
Endprocedure



Procedure supr_noirs()
      ;-Supr_noirs
      ; ; descente si noire dessous
      For y=12 to 2 step -1 ; pour chaque lignes (on part du bas)
            For x=1 to 20 ; pour chaque image
                  car_bas$=mid(ligne$(y),x,1)
                  car_haut$=mid(ligne$(y-1),x,1)
                  if car_bas$="0" ;  image noire
                        Swap car_haut$,car_bas$
                  Endif
                  l1$=l1$+car_bas$
                  l2$=l2$+car_haut$
            Next x
            ligne$(y)=l1$ :l1$=""
            ligne$(y-1)=l2$ :l2$=""
      Next y
      dessin()
EndProcedure
Procedure generation_premiere_ligne()
      ;-generation_1er_ligne
      ; remplacement des noirs de la premiere ligne suite a la descente
      For x=1 to 20
            de=random(4,1)
            if mid(ligne$(1),x,1)="0"
                  replacestring( ligne$(1),"0",str(de) ,#PB_String_InPlace,x,1); on remplce le noirs de la premiere ligne
            Endif
      Next x
      dessin()
EndProcedure

Procedure WindowCallback(WindowID, Message, wParam, lParam)
      ;-CallBack
      Result = #PB_ProcessPureBasicEvents
      Select Message
      Case #WM_LBUTTONDOWN
            Flag_start=#false
            xm=(WindowMouseX(#win)  )
            ym=(WindowMouseY(#win) )
            ;dessin()
            if ( xm<=x_larg ) and ( ym-100<=y_haut)
                  xx$="x="+str(((xm/32*20)/20+1/10)+1)
                  yy$="y="+str((((ym-100)/32*12)/12+1/10)+1)
                  ;SetWindowTitle(#Win,xx$+" "+yy$)
                  SetWindowTitle(#Win,"By Zorro")                  
                  lx=((xm/32*20)/20+1/10)+1
                  ly=(((ym-100)/32*12)/12+1/10)+1
            Endif
            if GetGadgetState(#Vert)=#True
             echange_vertical(Lx,Ly)
             Else
              echange_Horizontal(Lx,Ly)
             Endif
            Score.i=Score.i-20
            if Score.i<=0
                  Score.i=0
                  MessageRequester("alerte","Vous avez perdu")
                  End
            Endif
      Case #WM_RBUTTONDOWN
      Case #WM_KEYDOWN   
   if  wParam =16 ; Shift gauche   
   flag_touche=-flag_touche
   If flag_touche>0
   SetGadgetState(#Vert, #true)
   SetGadgetState(#Horiz, #False)
   Else
   SetGadgetState(#Horiz, #true)
   SetGadgetState(#Vert, #False)
   Endif
   Endif
      EndSelect
      ProcedureReturn Result
EndProcedure




_________________
Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"


Dernière édition par Zorro le Jeu 10/Nov/2016 12:25, édité 1 fois.

Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Candy
MessagePosté: Jeu 10/Nov/2016 12:16 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 23/Sep/2006 18:32
Messages: 6661
Localisation: Isere
Pas si facile ...
Marche nickel, au premier abord
Merci du partage 8)

_________________
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Candy
MessagePosté: Jeu 10/Nov/2016 12:28 
Hors ligne
Avatar de l’utilisateur

Inscription: Mar 31/Mai/2016 9:06
Messages: 2113
Changement du code
ajout de 2 options base, qui permettent l'echange dans le sens Vertical (comme avant )
ou horizontal !!

soit par un clique sur un optionbase, soit par appuis/relachement du Shift gauche (testez a vide )

comme sur un PC ont ne dispose pas du sens de la selection (poser le doigt puis glisser vers le haut ou la droite )

j'ai ajouté cette possibilité comme ça on peut choisir le sens de l'echange :)
voir la video ci dessus pour comprendre :)

precision:
pour le sens Vertical , l'echange a lieu entre la dalle cliqué et sa voisine du dessus
pour le sens horizontal,l'echange a lieu entre la dalle cliqué et sa voisine de droite !

_________________
Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Candy
MessagePosté: Jeu 10/Nov/2016 16:48 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 14/Oct/2004 19:48
Messages: 1121
Pourquoi tu ne fais pas l'échange entre la dalle sur laquelle on clic et celle sur laquelle on relâche le clic ?

_________________
Il y a deux méthodes pour écrire des programmes sans erreurs. Mais il n’y a que la troisième qui marche.
Version de PB : 5.45LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Candy
MessagePosté: Jeu 10/Nov/2016 19:33 
Hors ligne
Avatar de l’utilisateur

Inscription: Mar 31/Mai/2016 9:06
Messages: 2113
Fig a écrit:
Pourquoi tu ne fais pas l'échange entre la dalle sur laquelle on clic et celle sur laquelle on relâche le clic ?

ouaip, voir plutot un cliqu sur la dalle de depart, et un autre sur la dalle d'arrivé

je suis tombé sur un site internet, qui fait ça :)

pour le moment, je bosse sur l'animation pendant l'echange :)
ça prends forme ! :)
je me suis rendu compte que la code chez moi etait super lent, parceque j'avais laisser OpenGL en sous-system :roll:
et la 2cv qui me sert d'ordi, ben openGL,3D tout ça connait pas !

_________________
Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Candy
MessagePosté: Jeu 10/Nov/2016 21:01 
Hors ligne
Avatar de l’utilisateur

Inscription: Mar 31/Mai/2016 9:06
Messages: 2113
Version 3
Ajout d'animation pendant le deplacement
utilisation des images de circonstances
pour jouer, clique sur dalle de depart, et clique sur dalle d'arrivé dans tout les sens :)
note un clique sur case diagonal fonctionne ! regardez le mouvement :)

le bouton initialisation redessine une matrice complete


Image





Code:
;***********************************************
;Titre  :*Fish_crush_test
;Auteur  : Zorro
;Date  :09/11/2016
;Heure  :19:52:40
;Version Purebasic :  PureBasic 5.50 (Windows - x64)
;Version de l'editeur :EPB V2.64
; Libairies necessaire : Aucune
;***********************************************
; ToDo
; verifier le compteur de points ......(un peu moins severe au clique)
; voir le click pour depart, et clique pour arrivée !!
;

UseJPEGImageDecoder()
UsePNGImageDecoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()


Declare open_window()
Declare creation_map()
Declare echange_vertical(lx,ly)
Declare renvoi_numero_image(lx,ly)
Declare echange_horizontal(lx,ly)
Declare dessin()
Declare supr_horizontal()
Declare supr_vertical()
Declare supr_noirs()
Declare generation_premiere_ligne()
Declare anime_vertical_noir(lx,ly)
Declare anime_vertical(lx,ly)
Declare anime_horizontal(lx,ly)
Declare windowcallback(windowid, message, wparam, lparam)
Declare.l loadimage_net(num,adr$,nom_fichier$)
Declare.l loadmp3_net(nb,adr$,nom_fichier$)
Declare MP3_GetPosition(Nb)
Declare MP3_GetLength(Nb)
Declare MP3_PlayStart(Nb)




Enumeration ; win et gadgets
      #Win ; numero de la fenetre
      #Button_init ; numero du bouton
      #Titre
      #fonte_titre
      #Auteur
      #Score
      #T_Score
      #titre_up
      #Vert
      #Horiz
      #Container   
EndEnumeration
;
Enumeration ; les images
      #image_noir
      #image_rouge
      #image_vert
      #image_bleu
      #image_jaune
      #image_veraune
EndEnumeration
;
Enumeration ;les Sprites
      #Sprite_noir
      #Sprite_rouge
      #Sprite_vert
      #Sprite_bleu
      #Sprite_jaune
      #sprite_veraune
EndEnumeration
;
Enumeration ; les sons
      #nb
      #clic
      #destruc
EndEnumeration
;
InitMouse()
if InitSprite()=0
      MessageRequester("erreur","pas pu initialiser les sprites")
      End
Endif
Global x_larg=640
Global y_haut=384
Global Flag=#False
GLobal Score.i =250
Global Flag_start
Global flag_touche=1
Global dim colonne$(20)
Global Flag_click=0,mem_x,mem_x2,mem_y,mem_y2
Global flag_start_player=#False
Open_Window() ; appel de la procedure qui ouvre la fenetre
; ****** creation des sprites *********
; couleurs
; noir=rgb(0,0,0);0
; rouge=rgb(255,0,0) ;1
; vert=rgb(0,255,0);2
; bleu=rgb(0,0,255);3
; jaune=rgb(255,255,0);4
;
; Createimage(#image_noir,32,32) ; creation d'une cellule vide (un sprite)
; StartDrawing( imageOutput(#image_noir)) ; on va dessiner dans notre sprite un carre coloré
; Box(1,1,32,32,noir)
; StopDrawing()

; Createimage(#image_rouge,32,32) ; creation d'une cellule vide (un sprite)
; StartDrawing( imageOutput(#image_rouge)) ; on va dessiner dans notre sprite un carre coloré
; Box(1,1,32,32,rouge)
; StopDrawing()
; Createimage(#image_vert,32,32) ; creation d'une cellule vide (un sprite)
; StartDrawing( imageOutput(#image_vert)) ; on va dessiner dans notre sprite un carre coloré
; Box(1,1,32,32,vert)
; StopDrawing()
; Createimage(#image_bleu,32,32) ; creation d'une cellule vide (un sprite)
; StartDrawing( imageOutput(#image_bleu)) ; on va dessiner dans notre sprite un carre coloré
; Box(1,1,32,32,bleu)
; StopDrawing()
; Createimage(#image_jaune,32,32) ; creation d'une cellule vide (un sprite)
; StartDrawing( imageOutput(#image_jaune)) ; on va dessiner dans notre sprite un carre coloré
; Box(1,1,32,32,jaune)
; StopDrawing()
; random
Global Dim Ligne$(15)
;***********************Mode Local ***************
;LoadImage(#image_noir,"Picture0.png") :ResizeImage(#image_noir,32,32)
;LoadImage(#image_rouge,"Picture1.png") :ResizeImage(#image_rouge,32,32)
;LoadImage(#image_rouge,"Picture1.png") :ResizeImage(#image_rouge,32,32)
;LoadImage(#image_vert,"Picture2.png"):ResizeImage(#image_vert,32,32)
;LoadImage(#image_bleu,"Picture3.png"):ResizeImage(#image_bleu,32,32)
;LoadImage(#image_jaune,"Picture4.png"):ResizeImage(#image_jaune,32,32)
;
; ******************************* Mode Internet ***********************************
loadimage_net(#image_noir,"http://michel.dobro.free.fr/Purebasic/Fish/mer_images/","Picture0.png")
loadimage_net(#image_rouge,"http://michel.dobro.free.fr/Purebasic/Fish/mer_images/","Picture1.png")
loadimage_net(#image_vert,"http://michel.dobro.free.fr/Purebasic/Fish/mer_images/","Picture2.png")
loadimage_net(#image_bleu,"http://michel.dobro.free.fr/Purebasic/Fish/mer_images/","Picture3.png")
loadimage_net(#image_jaune,"http://michel.dobro.free.fr/Purebasic/Fish/mer_images/","Picture4.png")
loadimage_net(#image_veraune,"http://michel.dobro.free.fr/Purebasic/Fish/mer_images/","Picture5.png")
;
ResizeImage(#image_noir,32,32)
ResizeImage(#image_rouge,32,32)
ResizeImage(#image_vert,32,32)
ResizeImage(#image_bleu,32,32)
ResizeImage(#image_jaune,32,32)
ResizeImage(#image_veraune,32,32)
;
; *********************************************************************
; Createsprite(#Sprite_noir,64,64)
; StartDrawing(SpriteOutput(#Sprite_noir))
; DrawImage(ImageId(#image_noir),1,1)
; StopDrawing()
Createsprite(#Sprite_rouge,32,32)
StartDrawing(SpriteOutput(#Sprite_rouge))
      DrawImage(ImageId(#image_rouge),1,1)
StopDrawing()
Createsprite(#Sprite_vert,32,32)
StartDrawing(SpriteOutput(#Sprite_vert))
      DrawImage(ImageId(#image_vert),1,1)
StopDrawing()
Createsprite(#Sprite_bleu,32,32)
StartDrawing(SpriteOutput(#Sprite_bleu))
      DrawImage(ImageId(#image_bleu),1,1)
StopDrawing()
Createsprite(#Sprite_jaune,32,32)
StartDrawing(SpriteOutput(#Sprite_jaune))
      DrawImage(ImageId(#image_jaune),1,1)
StopDrawing()
Createsprite(#sprite_veraune,32,32)
StartDrawing(SpriteOutput(#sprite_veraune))
      DrawImage(ImageId(#image_veraune),1,1)
StopDrawing()



loadmp3_net(#nb,"http://michel.dobro.free.fr/Purebasic/Fish/","mouettes.mp3") ; pour avoir ambiance Port d'amsterdam

MP3_PlayStart(#nb) ; lance Mouettes ambiance

taille_music=MP3_GetLength(#nb)


loadmp3_net(#clic,"http://michel.dobro.free.fr/Purebasic/Fish/","click.mp3")


loadmp3_net(#destruc,"http://michel.dobro.free.fr/Purebasic/Fish/","destruc.mp3")






InitSound()
;music=CatchSound_Net(url_musique$)
;PlaySound(music,#PB_Sound_Loop,100)

Creation_map()

Repeat ; boucle principale , qui gere les affichages dans l'ecran graphique et les evenement de la fenetre
      pos_musique=MP3_GetPosition(#nb)
      if pos_musique= taille_music
            MP3_PlayStart(#nb)
      Endif
      
      event=WaitWindowEvent(5) ; attends de recevoir un evenements de la fenetre
      WindowID = EventWindow() ;
      EventType = EventType() ;
      select  event
            ; ********************************* regarde les evenements de gadget ***************************
      Case #PB_Event_Gadget
            Select EventGadget()
            Case #Button_init ; on a appuyé sur le bouton..!!
                  Creation_map()
            Case #vert
            Case #horiz
            EndSelect
      Case  #PB_Event_CloseWindow
            End
      Endselect
      ; ****************************************************************************
      supr_horizontal()
      supr_vertical()
      supr_noirs()
      generation_premiere_ligne()
      ;***************************************
      ; *****************************************
Forever
End
;
;- Zone Procedures
Procedure Open_Window()
      ;-Open_Window()
      If OpenWindow(#Win, 20, 50, 640,  600, "Fish",  #PB_Window_SystemMenu |  #PB_Window_TitleBar ) ; on ouvre une fenetre
            SmartWindowRefresh(#Win, #true)
            TextGadget(#Titre, 250, 10, 100, 30, "Fish",#PB_Text_Center)
            If LoadFont(#fonte_titre, "Arial", 24)
                  SetGadgetFont(#Titre, FontID(#fonte_titre))   ; la police par défaut est remplacée par celle chargée (Arial 16)
            EndIf
            TextGadget(#Auteur, 350, 30, 100, 20, "By Zorro",#PB_Text_Center)
            TextGadget(#T_Score, 10, 50, 50, 20, "Score :",#PB_Text_Center)
            TextGadget(#Score, 60, 50, 100, 20, "0000",#PB_Text_Center)
            OpenWindowedScreen(windowID(#Win), 1, 100, x_larg, y_haut, 0, 1, 1) ; on creer un ecran graphique dedans
            ButtonGadget(#Button_init, 30, 500, 100, 30, "Reinitialisation")  ; on suprime les series de 3 horizontal et on compress
            ; ContainerGadget(#Container, 160, 500,170, 50,#PB_Container_Single)
            ; OptionGadget(#Vert, 1, 1, 160, 20, "^ echange vertical")
            ; OptionGadget(#Horiz, 1, 30, 160, 20, "<> echange horizontal")
            ; SetGadgetState(#Vert, #true)
            ; CloseGadgetList()
            
            SetWindowCallback(@WindowCallback())
      EndIf
EndProcedure
;
Procedure Creation_map()
      ;- creaton tableau()
      Flag_start=#true
      RandomSeed(ElapsedMilliseconds())
      For y=1 to 12
            ligne$(y)=""
      Next y
      For y=1 to  12
            For x=1 to 20
                  de=random(5,1)
                  ligne$(y)=ligne$(y)+str(de)
            Next x
      Next y
      dessin() ; dessin du tableau
EndProcedure
;
Procedure echange_vertical(Lx,Ly)
      ;- echange Vertical de dalle()
      If Ly>1
            car_bas$=mid(ligne$(Ly),Lx,1)
            car_haut$=mid(ligne$(Ly-1),Lx,1)
            replacestring( ligne$(ly),car_bas$,car_haut$ ,#PB_String_InPlace,Lx,1)
            replacestring( ligne$(ly-1),car_haut$,car_bas$ ,#PB_String_InPlace,Lx,1)
      Endif
EndProcedure
;
Procedure renvoi_numero_image(Lx,Ly)
      If Ly>1 and Ly<13 and Lx>0 and Lx<21
            car$=mid(ligne$(Ly),Lx,1)
      Endif
      ProcedureReturn Val(car$)
EndProcedure
;
Procedure echange_Horizontal(Lx,Ly)
      ;- echange Horizontal de dalle()
      If Lx<20
            car_bas$=mid(ligne$(Ly),Lx,1)
            car_droit$=mid(ligne$(Ly),Lx+1,1)
            replacestring( ligne$(ly),car_bas$,car_droit$ ,#PB_String_InPlace,Lx,1)
            replacestring( ligne$(ly),car_droit$,car_bas$ ,#PB_String_InPlace,Lx+1,1)
      Endif
EndProcedure
;
Procedure dessin()
      ;-Dessin()
      StartDrawing(ScreenOutput())
      DrawingMode(#PB_2DDrawing_AlphaBlend )
            For y=1 to  12
                  For x=1 to 20
                        nbr$=Mid(ligne$(y),x,1)
                        DrawImage(imageId(0),xj,yj)
                        DrawAlphaImage(imageId(val(nbr$)),xj,yj)
                        xj=xj+32
                  Next x
                  xj=0
                  yj=yj+32
            Next y
      StopDrawing()
      FlipBuffers() ; execute l'affichage
      If Flag_start=#false
            SetGadgetText(#Score, str(score.i))
      Endif
EndProcedure
;
Procedure supr_horizontal()
      ;- supr_horizontal
      ; test horizontale verifie si 3 images ou plus (jusqu'a 20 ) semblable se suivent
      ; si c'est le cas on remplace par des case noires (0)
      For car=1 to 5
            ref$=LSet("", 20, str(car)) ; 20 caracteres possible
            For i=1 to 12 ; pour chaque lignes
                  For nb=20 to 3 step -1  ; on va rechercher les caracteres par groupe de 20 a 3 mini
                        ref2$=left(ref$,nb)
                        If FindString(ligne$(i),ref2$)
                              ReplaceString(ligne$(i),ref2$,LSet("", nb, "0"),#PB_String_InPlace)
                              If Flag_start=#false
                                    Score.i=Score.i+len(ref2$)
                              Endif
                        Endif
                  Next nb
            Next i
      Next car
      dessin()
      
EndProcedure
;
Procedure supr_vertical()
      ;- supr_Vertical
      ; test vertical verifie si 3 images ou plus (jusqu'a 12 ) semblable se suivent
      ; si c'est le cas on remplace par des case noires (0)
      dim colonne$(20)
      For x=1 to 20
            For y=1 to 12
                  colonne$(x)=colonne$(x)+mid(ligne$(y),x,1) ; on capture tout les caracteres de la colonne
            Next y
      Next x
      For x=1 to 20 ; pour chaque colonne
            For car=1 to 5
                  ref$=LSet("", 12, str(car)) ; 12 caracteres possible en vertical(forme "111111111111" -- 12 cars )
                  For nb=12 to 3 step-1  ; on va rechercher les caracteres par groupe de 12 a 3 mini
                        ref2$=left(ref$,nb)
                        If FindString(colonne$(x),ref2$)
                              ReplaceString(colonne$(x),ref2$,LSet("", nb, "0"),#PB_String_InPlace)
                              If Flag_start=#false
                                    Score.i=Score.i+len(ref2$)
                              Endif ;<
                        Endif ;<
                  Next nb
            Next car
      Next x
      For y=1 to 12
            Ligne$(y)=""
            For x=1 to 20
                  Ligne$(y)=Ligne$(y)+mid(colonne$(x),y,1);mid(colonne$,y,1)
            Next x
      Next y
      dessin()
      
Endprocedure
;
Procedure supr_noirs()
      ;-Supr_noirs
      ; ; descente si noire dessous
      For y=12 to 2 step -1 ; pour chaque lignes (on part du bas)
            For x=1 to 20 ; pour chaque colonne
                  car_bas$=mid(ligne$(y),x,1)
                  car_haut$=mid(ligne$(y-1),x,1)
                  if car_bas$="0" ;  image noire
                        ;Swap car_haut$,car_bas$
                        mem_car_haut$=car_haut$
                        Anime_vertical_noir(x,y)
                        replacestring( ligne$(y-1),car_haut$,car_bas$,#PB_String_InPlace,x,1); on echange le car de la ligne du haut
                        replacestring( ligne$(y),car_bas$,mem_car_haut$ ,#PB_String_InPlace,x,1); avec celle du bas
                        If flag_start_player=#True
                              MP3_PlayStart(#destruc)
                        Endif
                  Endif
            Next x
      Next y      
      dessin()      
EndProcedure
;
Procedure generation_premiere_ligne()
      ;-generation_1er_ligne
      ; remplacement des noirs de la premiere ligne suite a la descente
      For x=1 to 20
            de=random(5,1)
            if mid(ligne$(1),x,1)="0"
                  replacestring( ligne$(1),"0",str(de) ,#PB_String_InPlace,x,1); on remplce le noirs de la premiere ligne
            Endif
      Next x
      dessin()
EndProcedure
;
Procedure Anime_vertical_noir(Lx,Ly)
      ;- Animation verticale
      bas=renvoi_numero_image(Lx,Ly)
      haut=renvoi_numero_image(Lx,Ly-1)
      if bas=0 and haut>0 and Ly>0
            x_bas=(Lx*32)-32
            y_bas=(Ly*32)-32
            x_haut=x_bas
            y_haut=y_bas-32
            y2=y_haut
            For y= y_haut to y_bas
                  DisplaySprite(haut,x_haut,y);descend
            Next y
      Endif
EndProcedure
;
Procedure Anime_vertical(Lx,Ly)
      ;- Animation verticale
      bas=renvoi_numero_image(Lx,Ly)
      haut=renvoi_numero_image(Lx,Ly-1)
      if bas>0 and haut>0 and Ly>1
            x_bas=(Lx*32)-32
            y_bas=(Ly*32)-32
            x_haut=x_bas
            y_haut=y_bas-32
            y2=y_haut
            For y=y_bas to y_haut step -1
                  y2=y2+1
                  DisplaySprite(bas,x_bas,y)
                  DisplaySprite(haut,x_bas,y2)
                  FlipBuffers()
            Next y
            delay(100)
         ;   DisplaySprite(haut,-1000,y)
         ;   DisplaySprite(bas,-1000,y)
      Endif
EndProcedure
;
Procedure Anime_Horizontal(Lx,Ly)
      ;- Animation_Horizontal
      gauche=renvoi_numero_image(Lx,Ly)
      droit=renvoi_numero_image(Lx+1,Ly)
      if gauche>0 and Lx<20
            y_gauche=(Ly*32)-32
            y_droit=y_gauche
            x_gauche=(Lx*32)-32
            x_droit=x_gauche+32
            x2=x_gauche
            For x=x_droit to x_gauche step -1
                  x2=x2+1
                  DisplaySprite(gauche,x2,y_gauche)
                  DisplaySprite(droit,x,y_droit)
                  FlipBuffers()
            Next x
            delay(100)
            DisplaySprite(droit,-1000,y_gauche)
            DisplaySprite(gauche,-1000,y_gauche)
      Endif
EndProcedure
;
Procedure WindowCallback(WindowID, Message, wParam, lParam)
      ;-CallBack
      Result = #PB_ProcessPureBasicEvents
      Select Message
      Case #WM_LBUTTONDOWN
            Flag_start=#false
            xm=(WindowMouseX(#win)  )
            ym=(WindowMouseY(#win) )
            xx$="x="+str(((xm/32*20)/20+1/10)+1)
            yy$="y="+str((((ym-100)/32*12)/12+1/10)+1)
            ;SetWindowTitle(#Win,xx$+" "+yy$)
            SetWindowTitle(#Win,"By Zorro")
            lx=((xm/32*20)/20+1/10)+1
            ly=(((ym-100)/32*12)/12+1/10)+1
            if Flag_click=0
                  Flag_click=1
                  mem_x=lx
                  mem_y=ly
                  ;   beep_(440,100)
                  MP3_PlayStart(#clic)
                  ProcedureReturn Result
            Endif
            if Flag_click=1
                  ;   beep_(880,100)
                  flag_start_player=#true
                  MP3_PlayStart(#clic)
                  mem_x2=lx
                  mem_y2=ly
                  Flag_click=0
                  ; Action
                  eccartx=mem_x-mem_x2:if eccartx<0:eccartx=-eccartx:Endif
                  eccarty=mem_y-mem_y2:if eccarty<0:eccarty=-eccarty:Endif
                  if eccartx=1
                        if mem_x<mem_x2
                              Anime_Horizontal(mem_x,Ly)
                              echange_Horizontal(mem_x,Ly)
                        Else
                              Anime_Horizontal(mem_x2,Ly)
                              echange_Horizontal(mem_x2,Ly)
                        Endif
                        Score.i=Score.i-5
                  Endif;|
                        If  eccarty=1
                              if mem_y<mem_y2
                                    Anime_vertical(Lx,mem_y2)
                                    echange_vertical(Lx,mem_y2)
                              Else
                                    Anime_vertical(Lx,mem_y)
                                    echange_vertical(Lx,mem_y)
                              Endif
                              Score.i=Score.i-5
                        Endif
                        ProcedureReturn Result
            Endif;<
                        
                        ; if GetGadgetState(#Vert)=#True
                        ; Anime_vertical(Lx,Ly)
                        ; echange_vertical(Lx,Ly)
                        ; Else
                        ; Anime_Horizontal(Lx,Ly)
                        ; echange_Horizontal(Lx,Ly)
                        ;
                        ; Endif
                        
                        if Score.i<=0
                              Score.i=0
                              MessageRequester("alerte","Vous avez perdu")
                              Score.i =250 ; on reinitialise pour pouvoir continer a jouer
                        Endif
                  Case #WM_RBUTTONDOWN
                  Case #WM_KEYDOWN
                        ; if  wParam =16 ; Shift gauche
                        ;                               flag_touche=-flag_touche
                        ;                               If flag_touche>0
                        ;                                     SetGadgetState(#Vert, #true)
                        ;                                     SetGadgetState(#Horiz, #False)
                        ;                               Else
                        ;                                     SetGadgetState(#Horiz, #true)
                        ;                                     SetGadgetState(#Vert, #False)
                        ;                               Endif
                        ;                         Endif
                        
                  EndSelect
                  ProcedureReturn Result
EndProcedure;]
;
Procedure.l Loadimage_net(num,Adr$,nom_fichier$)
      ; By Dobro
      ;num = numero d'image qu'on desire
      ;Adr$=adresse du fichier image a charger
      ;nom_image$ = nom qu'on donne a cette image
      Protected image
      if InitNetwork()
            path$=GetTemporaryDirectory()
            If ReceiveHTTPFile(Adr$+nom_fichier$,path$+nom_fichier$)
                  LoadImage(num,path$+nom_fichier$)
                  DeleteFile(path$+nom_fichier$)
            Else
                  ProcedureReturn #false
            EndIf
      Else
            ProcedureReturn #false
      Endif
EndProcedure ;]





Procedure.l LoadMP3_net(Nb,Adr$,nom_fichier$)
      ; By Dobro
      ;Adr$=adresse du fichier image a charger
      ;nom_fichier$ = nom qu'on donne a ce Mp3
      ; la procedure renvoi l'Id de la Music recupérée ou False en cas d'erreur
      
      Protected  path$
      InitNetwork()
      path$=GetTemporaryDirectory()
      If ReceiveHTTPFile(Adr$+nom_fichier$, path$+nom_fichier$)
            i=mciSendString_("OPEN "+Chr(34)+path$+nom_fichier$+Chr(34)+" Type MPEGVIDEO ALIAS MP3_"+Str(Nb),0,0,0)
            If i=0
                  ProcedureReturn #True
            Else
                  ProcedureReturn #False
            EndIf
      Endif
EndProcedure
Procedure MP3_GetPosition(Nb)
      a$=Space(#MAX_PATH)
      i=mciSendString_("status MP3_"+Str(Nb)+" position",@a$,#MAX_PATH,0)
      ProcedureReturn Val(a$)
EndProcedure
Procedure MP3_GetLength(Nb)
      a$=Space(#MAX_PATH)
      i=mciSendString_("status MP3_"+Str(Nb)+" length",@a$,#MAX_PATH,0)
      ProcedureReturn Val(a$)
EndProcedure
Procedure MP3_PlayStart(Nb)
      if Nb=#nb
            i=mciSendString_("play MP3_"+Str(Nb)+" from "+Str(1000),0,0,0)
      Else
            i=mciSendString_("play MP3_"+Str(Nb)+" from "+Str(0),0,0,0)
      Endif
      ProcedureReturn i
EndProcedure


_________________
Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"


Dernière édition par Zorro le Mar 15/Nov/2016 11:54, édité 11 fois.

Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Candy
MessagePosté: Ven 11/Nov/2016 9:53 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 2213
Localisation: 50200 Coutances
Superbe travail, j'adopte ! Merci pour le partage !

_________________
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce GT 640 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.62, 5.70 LTS
Un homme doit être poli, mais il doit aussi être libre !


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Candy
MessagePosté: Ven 11/Nov/2016 11:18 
Hors ligne
Avatar de l’utilisateur

Inscription: Mar 31/Mai/2016 9:06
Messages: 2113
modification du code de la version 2
Ajout d'un nouveau "bonbon" (voir video ci dessus )
suppression de l'effet "Case noir"

modification legere au niveau de la "remonté des noirs vers le haut" de la procedure supr_noirs()
(je n'utilise plus Swap , mais replaceString() ) histoire d'uniformiser mon code

maintenant, faut que je trouve une musique bien chiante :lol:

_________________
Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Candy
MessagePosté: Ven 11/Nov/2016 12:19 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 19/Fév/2011 12:46
Messages: 1880
salut

C'est vraiment pas mal.
Deux petites améliorations :
- dans ton code, plutôt que de "forcer" les échanges, tu devrais garder le premier élément cliqué, puis le second. Si le second est à coté du premier (droite ou gauche) ou aude-ssus/en dessous, alors tu fais l'échange. ça permettrait de faire des échanges dans n'importe quel direction.
- pour les animations de descente, lorsque tu changes une lignes, et s'il y a une case noire, ne peux-tu donner une nouvelle position à l'élément puis le faire glisser vers sa nouvelle position (en général, la case en dessous) ?

Sinon, c'est pas mal, l'idée d'utiliser les string est une très bonne idée. JE vais voir si je peux utiliser ça dans mon code ;).

_________________
http://blendman.blogspot.com/
Forum PB fr : http://www.purebasic.fr/french - Forum PB Eng : http://www.purebasic.fr/english


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Candy
MessagePosté: Ven 11/Nov/2016 12:25 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 13/Déc/2015 11:05
Messages: 649
Localisation: Allez, cherche...
Exellent travail !! merci du partage :P

_________________
"Le bug se situe entre la chaise et le clavier"
Votre expert national en bogage et segfaults.

CPU : AMD A8 Quad core - RAM 8Gb - HDD 2To
  • Windows 10 x64 - PB 5.61 x64
  • Linux Ubuntu 16.04 LTS x64 (dual boot) - PB pas encore réinstallé


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Candy
MessagePosté: Ven 11/Nov/2016 14:09 
Hors ligne
Avatar de l’utilisateur

Inscription: Mar 31/Mai/2016 9:06
Messages: 2113
Merci :)
blendman a écrit:
- dans ton code, plutôt que de "forcer" les échanges, tu devrais garder le premier élément cliqué, puis le second. Si le second est à coté du premier (droite ou gauche) ou aude-ssus/en dessous, alors tu fais l'échange. ça permettrait de faire des échanges dans n'importe quel direction.


oui c'est prevue :)
je suis tombé sur un site qui propose le jeux en ligne , qui pratique de la sorte :)

Citation:
- pour les animations de descente, lorsque tu changes une lignes, et s'il y a une case noire, ne peux-tu donner une nouvelle position à l'élément puis le faire glisser vers sa nouvelle position (en général, la case en dessous) ?


en fait a l'heure actuel , un echange est fait pour faire remonter les cases noires vers le haut de la matrice
et donc par effet de swap, on a l'impression que ce sont les couleurs qui descendent
mais en fait, c'est bien les cases "noire" (en fait la valeur "0" dans mes lignes de caracteres , que je fais remonter

et l'echange a lieu de façon brute !! ; je n'ai pas ajouté d'animation, comme je le fais pour un echange de 2 cases (non "0") :)
il suffit que je m'y mette :) c'est prevue , Merci de ta remontée d'idées

en meme temps, mon but etait de faire un exemple , et me voila a faire le jeux complet :lol:

Citation:
Sinon, c'est pas mal, l'idée d'utiliser les string est une très bonne idée. JE vais voir si je peux utiliser ça dans mon code ;).


en fait, cela me viens du codage "oldSchool" , ou il etait tres courant de faire la logique interne d'un jeux en utilisant les
caracteres , (séparation de la logique du jeux (format caractere ) et de sa partie visible (le decorum)

par exemple dans un jeux type pacMan un tableau peut etre sous forme de Data

Code:
data.b 1,1,1,1,1,1,1,1
data.b 1,0,0,0,0,0,0,1
data.b 1,0,0,0,0,0,0,1
data.b 1,0,0,0,0,0,0,1
data.b 1,0,0,0,0,0,0,1
data.b 1,1,1,1,1,1,1,1


lorsque le joueur avance dans le niveau, on fait correspondre sa position (par modulo) a celle des "caracteres" des Datas
le prg lui ne regarde que les Data, et sa partie "peinture" affiche le décorum , d'ailleurs d'autres valeurs peuvent représenter des objets, des "tuiles" differentes
lorsque le joueur arrive sur la valeur (ou le caractere) "1" , on le bloque !!
le joueur a l'impression de ne pas pouvoir traverser le mur
s'il se trouve sur un "0" pas de probleme, il peut bouger :)

c'est vraiment la base du codage "OldSchool" ça permet meme de se passer de fonctions évoluées de détection de collision
puisque celle-ci est effectué par la lecture des datas :)
note : majikeyric connait bien ce principe, il ressort souvent dans ses codes ...

dans mon code, je reprends exactement le meme principe, mon prg ne gere que des lignes de textes
il regarde si on doit échanger tel ou tel caractères (un caractère correspond a une dalle ... un bonbon)
en fonction de sa nature "1","2","3" etc... la partie "peinture" affiche la bonne Dalle
que l'utilisateur naïf, trouvera jolie ou pas, mais le prg lui, en interne, ne "voit" que des caractères :)

je pense, que cette façon de coder,que je nomme "old-school" permet de coder pleins de trucs différent
par exemple un scroll-text , chaque caractère chaîne du prg correspond a une lettre graphique de la planche des fontes
si un caractère special est rencontré en interne (genre ";" ou "_", on change la reaction du prg
par exemple, en affichant ailleurs la suite du scroll-text, ou en changeant le sens du défilé ou ça déclenche une musique, un bruit ect..

cette aprem, je ne pourrai pas, mais je reprendrai mon code plus tards , merci pour les retours :)
tien en parlant de retour, j'ai mangé trop d'ails , alors maintenant, j'ai des renvois .... des retours de jets d'ails :mrgreen:

[reedit] , je nomme cette façon de coder, Old-School ,car les Ordinateurs n'ont pas toujours eu le graphisme
d'aujourd'hui , exemple mon Cannon X-07 (quelques lignes de text ) et que coder un jeux la dessus, c'etait caractères obligatoire :)

_________________
Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"


Dernière édition par Zorro le Ven 11/Nov/2016 19:33, édité 1 fois.

Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Candy
MessagePosté: Ven 11/Nov/2016 15:24 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 19/Fév/2011 12:46
Messages: 1880
En plus, cette méthode d'utilisation de caractère a l'énorme avantage de pouvoir ne remonter (ou descendre) que si le caractère trouvé est "0".
Si par exemple, on veut ajouter des caractères "immobiles" (comme des cases vides) ou temporaire (comme des coffres), c'est possible aussi :)

_________________
http://blendman.blogspot.com/
Forum PB fr : http://www.purebasic.fr/french - Forum PB Eng : http://www.purebasic.fr/english


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Candy
MessagePosté: Ven 11/Nov/2016 16:51 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 09/Oct/2005 16:51
Messages: 8785
Même principe que pour les cases briques niveau creation de level :)
ça commence à bien rendre.

_________________
~~~~Règles du forum ~~~~
.: Ar-S :. Tour + portable W10 x64 PB 5.4x / 5.6x
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
RESIZER GOLD : Mon logiciel de redimensionnement par lot 100% PB


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Candy
MessagePosté: Ven 11/Nov/2016 19:23 
Hors ligne
Avatar de l’utilisateur

Inscription: Mar 31/Mai/2016 9:06
Messages: 2113
je bosse sur l'animation des Bonbons qui tombent (quasi fini )
demain je verrai le reste :)

_________________
Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Candy
MessagePosté: Ven 11/Nov/2016 19:23 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 19/Fév/2011 12:46
Messages: 1880
@Zorro : j'ai légèrement modifié tes 2 procédures de suppression des éléments, pour pouvoir avoir des bloc de 3, 4, ou 5 elements qui se suivent.
Il manque les blocs en croix (par 3) et en T (par trois aussi), mais c'est déjà pas mal

Code:



Procedure supr_horizontal()

    ;- supr_horizontal
    ; test horizontale verifie si au moins 3 images semblable se suivent (3, 4 ou 5 images)
    ; si c'est le cas on remplace par des case noires (0)
    For i=1 To 12 ; pour chaque lignes
       
        For u= 1 To 5
            ; je définie les string qu'on cherche : "111", ou "1111" ou "11111", ou "222", ou "2222", etc... si on a plus de 5 images différent, il suffit de modifier le u de la ligne au-dessus
            m3$ = Str(u)+Str(u)+Str(u)
            m4$ = Str(u)+Str(u)+Str(u)+Str(u)
            m5$ = Str(u)+Str(u)+Str(u)+Str(u)+Str(u)
            m6$ = Str(u)+Str(u)+Str(u)+Str(u)+Str(u)+Str(u)
            m7$ = Str(u)+Str(u)+Str(u)+Str(u)+Str(u)+Str(u)+Str(u)
           
            ; puis, je cherche si on a 3 images, 4 ou 5 identiques

           If FindString(ligne$(i),m5$)
                ligne$(i)=ReplaceString(ligne$(i),m5$,"00000")
            EndIf   
            If FindString(ligne$(i),m4$)
                ligne$(i)=ReplaceString(ligne$(i),m4$,"0000")
            EndIf 
            If FindString(ligne$(i),m3$)
                ligne$(i)=ReplaceString(ligne$(i),m3$,"000")
            EndIf
           
           
        Next u
               
    Next i
   
    dessin()
   
EndProcedure

Procedure supr_vertical()
   
    ;- supr_Vertical
    For x=1 To 20
       
        For y=1 To 12
           
            car1$=Mid(ligne$(y),x,1)
            car2$=Mid(ligne$(y+1),x,1)
            car3$=Mid(ligne$(y+2),x,1)
           
            ;{ pour vérifier si on 4 ou 5 images identiques
            car4$ = "-1"
            car5$ = "-1"
           
            If y <=11
                car4$=Mid(ligne$(y+3),x,1)
            EndIf
            If y <=10
                car5$=Mid(ligne$(y+4),x,1)
            EndIf
            ;}

            If car1$<>"0"
                If car3$=car2$ And car3$=car1$
                   
                    If car4$=car1$    ; 4 images identiques ?                   
                        If car5$=car1$ ; 5 elements identiques ?
                            Bonus = 5     
                            ReplaceString( ligne$(y),car1$,"0",#PB_String_InPlace,x,1)
                            ReplaceString( ligne$(y+1),car2$,"0",#PB_String_InPlace,x,1)
                            ReplaceString( ligne$(y+2),car3$,"0" ,#PB_String_InPlace,x,1)
                            ReplaceString( ligne$(y+3),car4$,"0" ,#PB_String_InPlace,x,1)
                            ReplaceString( ligne$(y+4),car5$,"0" ,#PB_String_InPlace,x,1)
                        Else ; 4 elements identiques seulement
                            Bonus = 4     
                            ReplaceString( ligne$(y),car1$,"0",#PB_String_InPlace,x,1)
                            ReplaceString( ligne$(y+1),car2$,"0",#PB_String_InPlace,x,1)
                            ReplaceString( ligne$(y+2),car3$,"0" ,#PB_String_InPlace,x,1)
                            ReplaceString( ligne$(y+3),car4$,"0" ,#PB_String_InPlace,x,1)
                        EndIf
                    Else    ; 3 elements identiques     seulement
                        Bonus = 3               
                        ReplaceString( ligne$(y),car1$,"0",#PB_String_InPlace,x,1)
                        ReplaceString( ligne$(y+1),car2$,"0",#PB_String_InPlace,x,1)
                        ReplaceString( ligne$(y+2),car3$,"0" ,#PB_String_InPlace,x,1)
                    EndIf

                    If Flag_start=#False
                        Score.i=Score.i+Bonus
                    EndIf

                EndIf
            EndIf
           
        Next y
    Next x
   
EndProcedure




Je ne sais pas si ça te semble correct ?

_________________
http://blendman.blogspot.com/
Forum PB fr : http://www.purebasic.fr/french - Forum PB Eng : http://www.purebasic.fr/english


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 26 messages ]  Aller à la page 1, 2  Suivante

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 3 invités


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye