It is currently Sat Dec 16, 2017 7:33 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 11 posts ] 
Author Message
 Post subject: Candy Crush principle
PostPosted: Thu Nov 10, 2016 12:37 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Oct 31, 2004 10:54 am
Posts: 748
Location: France
a prg style Candy Crush

Image

at startup, the table is initialized

the "initialization" button serves to revive a generation table

to play, just look to do alignments of color 3 slabs, in vertical or horizontal


it may be that several slabs eventually align and create new allignements
increasing the number of points (snowball)

a clique that does not work, lose points

adding 2 basic options, which allow the exchange in the Vertical direction (as before)
or horizontal !!

either by clicking on a OptionBase or through support / loosening the left Shift (test to see)

on a PC did not have the sense of selection (put your finger and slide up or right)

I added this option as it can select the direction of trade :)
see the above video to understand :)

precision:
Vertical direction for the exchange takes place between the clicked tile and its upstairs neighbor
for the horizontal direction, the exchange takes place between the clicked tile and its neighbor to the right!

Code:
;***********************************************
;Titre  :*candy_crush_test
;Auteur  : Zorro (Dobro)
;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
Windows 98/7/10 - PB 5.42
■ sites : http://michel.dobro.free.fr/


Top
 Profile  
Reply with quote  
 Post subject: Re: Candy Crush principle
PostPosted: Thu Nov 10, 2016 4:13 pm 
Offline
Enthusiast
Enthusiast

Joined: Fri Oct 16, 2009 10:12 am
Posts: 533
Location: BE
I like it.

Thanks.

_________________
Yeah I know, but keep in mind ... Leonardo da Vinci was also an autodidact.


Top
 Profile  
Reply with quote  
 Post subject: Re: Candy Crush principle
PostPosted: Thu Nov 10, 2016 9:07 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Oct 31, 2004 10:54 am
Posts: 748
Location: France
Thanks :)

Version 3

Add animation while moving
Use of images of circumstances

To play it click on first cell, and click on the cell of destination (any direction)

Will see later what I will do about it :)

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
Windows 98/7/10 - PB 5.42
■ sites : http://michel.dobro.free.fr/


Last edited by dobro on Tue Nov 15, 2016 11:59 am, edited 7 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Candy Crush principle
PostPosted: Thu Nov 10, 2016 9:34 pm 
Offline
Addict
Addict

Joined: Fri Nov 09, 2012 11:04 pm
Posts: 1465
Location: Uttoxeter, UK
@dobro,

Very nice. Thank you for sharing. :D

Could I make a couple of suggestions:

1. Perhaps Right- and Left-Click could be assigned to Vertical and Horizontal?
2. That if there are more than 3 in-a-line - all could be removed?

_________________
DE AA EB


Top
 Profile  
Reply with quote  
 Post subject: Re: Candy Crush principle
PostPosted: Fri Nov 11, 2016 9:17 am 
Offline
Moderator
Moderator
User avatar

Joined: Thu Dec 31, 2009 11:05 pm
Posts: 382
Location: Berlin and Ibiza
The version 2 is very nice. Image

_________________
ImageImageImageImage


Top
 Profile  
Reply with quote  
 Post subject: Re: Candy Crush principle
PostPosted: Fri Nov 11, 2016 11:23 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Oct 31, 2004 10:54 am
Posts: 748
Location: France
Thanks :)

Modification of the version 2 of code
Added a new "sweet" (see video above)
Suppression of the effect "Case black"

Slight modification at the level of the "rise of supr_noirs() procedure
(I no longer use Swap, but replaceString ()) history to standardize my code

Now I have to find a very boring music: lol:

@Davido :

davido wrote:
@dobro,

Very nice. Thank you for sharing. :D

Could I make a couple of suggestions:

1. Perhaps Right- and Left-Click could be assigned to Vertical and Horizontal?


Good Idea , for the futur :)

_________________
Image
Windows 98/7/10 - PB 5.42
■ sites : http://michel.dobro.free.fr/


Top
 Profile  
Reply with quote  
 Post subject: Re: Candy Crush principle
PostPosted: Fri Nov 11, 2016 2:19 pm 
Offline
Enthusiast
Enthusiast

Joined: Fri Oct 16, 2009 10:12 am
Posts: 533
Location: BE
@dobro the score has a strange way of counting.

How does it go ?
I notice sometimes it's going up, then down for unclear reason ?

_________________
Yeah I know, but keep in mind ... Leonardo da Vinci was also an autodidact.


Top
 Profile  
Reply with quote  
 Post subject: Re: Candy Crush principle
PostPosted: Sat Nov 12, 2016 1:16 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Oct 31, 2004 10:54 am
Posts: 748
Location: France
@joris fixed ;) Thanks

I changed the code from version 2 to version 3 :)

Now it takes into account whether an alignment of 3 to 12 columns or 3 to 20 line (thanks blendman for the idea)
I just redid the algo, using a shorter code :)

To play it click on first cell, and click on the cell of destination (any direction)

:)

than to find a music of atmosphere, and can be bonuses this kind of stuff, or an animation of explosion
When the sweets are lined up and found by the prg ... short, the imagination to power :)

_________________
Image
Windows 98/7/10 - PB 5.42
■ sites : http://michel.dobro.free.fr/


Top
 Profile  
Reply with quote  
 Post subject: Re: Candy Crush principle
PostPosted: Sun Nov 13, 2016 12:21 pm 
Offline
Enthusiast
Enthusiast

Joined: Fri Oct 16, 2009 10:12 am
Posts: 533
Location: BE
My 5 cents.

Changed some colors.
Code:
;***********************************************
;Titre  :*candy_crush_test
;Auteur  : Zorro (Dobro)
;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
noir=RGB(180,180,180);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

fnoir=RGB(80,80,80);0
frouge=RGB(155,0,0) ;1
fvert=RGB(0,155,0)  ;2
fbleu=RGB(0,0,155)  ;3
fjaune=RGB(155,155,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é
DrawingMode(#PB_2DDrawing_Gradient)     
BackColor(noir)
FrontColor(fnoir)
CircularGradient(15,20,14)
Circle(16,16, 16)
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é
DrawingMode(#PB_2DDrawing_Gradient)     
BackColor(rouge)
FrontColor(frouge)
CircularGradient(15,20,14)
Circle(16,16, 16)
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é
DrawingMode(#PB_2DDrawing_Gradient)     
BackColor(vert)
FrontColor(fvert)
CircularGradient(15,20,14)
Circle(16,16, 16)
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é
DrawingMode(#PB_2DDrawing_Gradient)     
BackColor(bleu)
FrontColor(fbleu)
CircularGradient(15,20,14)
Circle(16,16, 16)
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é
DrawingMode(#PB_2DDrawing_Gradient)     
BackColor(jaune)
FrontColor(fjaune)
CircularGradient(15,20,14)
Circle(16,16, 16)
StopDrawing()



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()
  Delay(1)
  ;***************************************
  ; *****************************************
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
      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
      echange_Horizontal(Lx,Ly)
     
    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

Carefull... getting addicted...

_________________
Yeah I know, but keep in mind ... Leonardo da Vinci was also an autodidact.


Top
 Profile  
Reply with quote  
 Post subject: Re: Candy Crush principle
PostPosted: Mon Nov 14, 2016 11:16 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Oct 31, 2004 10:54 am
Posts: 748
Location: France
:)

I modified my second code
To add sound

1 sound of atmosphere "forest and birds"
Otherwise by activating line code 179, and commenting on line 180
We can activate the atmosphere "Port of amsterdam"

1 sound for the clique

1 sound for the "destruction" (collection) of sweets


Reminder .... now; One clicks on the starting square, and then one clicks on the box of arrival to make the permutation

@joris, Yes, we can modify at leisure the "sweet"
See even change the rules of the game :)

_________________
Image
Windows 98/7/10 - PB 5.42
■ sites : http://michel.dobro.free.fr/


Top
 Profile  
Reply with quote  
 Post subject: Re: Candy Crush principle
PostPosted: Tue Nov 15, 2016 12:02 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Oct 31, 2004 10:54 am
Posts: 748
Location: France
Finally, to avoid any problems related to copyright

I changed the theme of my demo
I matched the sounds "port of amsterdam"

And therefore modified, code number 2, according ... :)

Image

_________________
Image
Windows 98/7/10 - PB 5.42
■ sites : http://michel.dobro.free.fr/


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 11 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 2 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye