Candy Crush principle

Advanced game related topics
User avatar
dobro
Enthusiast
Enthusiast
Posts: 766
Joined: Sun Oct 31, 2004 10:54 am
Location: France
Contact:

Candy Crush principle

Post by dobro »

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: Select all

;***********************************************
;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/
Joris
Addict
Addict
Posts: 885
Joined: Fri Oct 16, 2009 10:12 am
Location: BE

Re: Candy Crush principle

Post by Joris »

I like it.

Thanks.
Yeah I know, but keep in mind ... Leonardo da Vinci was also an autodidact.
User avatar
dobro
Enthusiast
Enthusiast
Posts: 766
Joined: Sun Oct 31, 2004 10:54 am
Location: France
Contact:

Re: Candy Crush principle

Post by dobro »

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: Select all

;***********************************************
;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








Last edited by dobro on Tue Nov 15, 2016 11:59 am, edited 7 times in total.
Image
Windows 98/7/10 - PB 5.42
■ sites : http://michel.dobro.free.fr/
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Candy Crush principle

Post by davido »

@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
User avatar
RSBasic
Moderator
Moderator
Posts: 1218
Joined: Thu Dec 31, 2009 11:05 pm
Location: Gernsbach (Germany)
Contact:

Re: Candy Crush principle

Post by RSBasic »

The version 2 is very nice. Image
Image
Image
User avatar
dobro
Enthusiast
Enthusiast
Posts: 766
Joined: Sun Oct 31, 2004 10:54 am
Location: France
Contact:

Re: Candy Crush principle

Post by dobro »

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/
Joris
Addict
Addict
Posts: 885
Joined: Fri Oct 16, 2009 10:12 am
Location: BE

Re: Candy Crush principle

Post by Joris »

@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.
User avatar
dobro
Enthusiast
Enthusiast
Posts: 766
Joined: Sun Oct 31, 2004 10:54 am
Location: France
Contact:

Re: Candy Crush principle

Post by dobro »

@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/
Joris
Addict
Addict
Posts: 885
Joined: Fri Oct 16, 2009 10:12 am
Location: BE

Re: Candy Crush principle

Post by Joris »

My 5 cents.

Changed some colors.

Code: Select all

;***********************************************
;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.
User avatar
dobro
Enthusiast
Enthusiast
Posts: 766
Joined: Sun Oct 31, 2004 10:54 am
Location: France
Contact:

Re: Candy Crush principle

Post by dobro »

:)

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/
User avatar
dobro
Enthusiast
Enthusiast
Posts: 766
Joined: Sun Oct 31, 2004 10:54 am
Location: France
Contact:

Re: Candy Crush principle

Post by dobro »

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/
Post Reply