Candy
Publié : jeu. 10/nov./2016 9:48
voici donc suite au post de Blendman, une version d'un prg style Candy crush
au demarrage, le tableau s'initialise
le bouton "initialisation" sert a relancer une generation de tableau
pour jouer, il suffit de chercher a faire des allignements de couleurs de 3 dalles , en verticale ou horizontale
en cliquant sur une dalle , ça echange avec son voisin du dessus
il se peux que plusieurs dalles finissent par s'aligner et creer de nouveaux allignements
ce qui augmente le nombre de points (effet boule de neige )
un clique qui ne donne rien, fait perdre des points
au demarrage, le tableau s'initialise
le bouton "initialisation" sert a relancer une generation de tableau
pour jouer, il suffit de chercher a faire des allignements de couleurs de 3 dalles , en verticale ou horizontale
en cliquant sur une dalle , ça echange avec son voisin du dessus
il se peux que plusieurs dalles finissent par s'aligner et creer de nouveaux allignements
ce qui augmente le nombre de points (effet boule de neige )
un clique qui ne donne rien, fait perdre des points
Code : Tout sélectionner
;***********************************************
;Titre :*candy_crush_test
;Auteur : Zorro
;Date :09/11/2016
;Heure :19:52:40
;Version Purebasic : PureBasic 5.50 (Windows - x64)
;Version de l'editeur :EPB V2.64
; Libairies necessaire : Aucune
;***********************************************
;
Declare creation_map()
Declare echange_vertical(Lx,Ly)
Declare echange_Horizontal(Lx,Ly)
Declare dessin()
Declare open_window()
Declare supr_horizontal()
Declare supr_vertical()
Declare supr_noirs()
Declare generation_premiere_ligne()
Declare windowcallback(windowid, message, wparam, lparam)
Enumeration
#Win ; numero de la fenetre
#Button_init ; numero du bouton
#Titre
#fonte_titre
#Auteur
#Score
#T_Score
#titre_up
#Vert
#Horiz
#Container
EndEnumeration
Enumeration
#image_noir
#image_rouge
#image_vert
#image_bleu
#image_jaune
EndEnumeration
InitMouse()
if InitSprite()=0
MessageRequester("erreur","pas pu initialiser les sprites")
End
Endif
Global x_larg=640
Global y_haut=384
Global Flag=#False
GLobal Score.i =250
Global Flag_start
Global flag_touche=1
Open_Window() ; appel de la procedure qui ouvre la fenetre
; ****** creation des sprites *********
; couleurs
noir=rgb(0,0,0);0
rouge=rgb(255,0,0) ;1
vert=rgb(0,255,0);2
bleu=rgb(0,0,255);3
jaune=rgb(255,255,0);4
Createimage(#image_noir,32,32) ; creation d'une cellule vide (un sprite)
StartDrawing( imageOutput(#image_noir)) ; on va dessiner dans notre sprite un carre coloré
Box(1,1,32,32,noir)
StopDrawing()
Createimage(#image_rouge,32,32) ; creation d'une cellule vide (un sprite)
StartDrawing( imageOutput(#image_rouge)) ; on va dessiner dans notre sprite un carre coloré
Box(1,1,32,32,rouge)
StopDrawing()
Createimage(#image_vert,32,32) ; creation d'une cellule vide (un sprite)
StartDrawing( imageOutput(#image_vert)) ; on va dessiner dans notre sprite un carre coloré
Box(1,1,32,32,vert)
StopDrawing()
Createimage(#image_bleu,32,32) ; creation d'une cellule vide (un sprite)
StartDrawing( imageOutput(#image_bleu)) ; on va dessiner dans notre sprite un carre coloré
Box(1,1,32,32,bleu)
StopDrawing()
Createimage(#image_jaune,32,32) ; creation d'une cellule vide (un sprite)
StartDrawing( imageOutput(#image_jaune)) ; on va dessiner dans notre sprite un carre coloré
Box(1,1,32,32,jaune)
StopDrawing()
; random
Global Dim Ligne$(15)
;**************************************
Creation_map()
Repeat ; boucle principale , qui gere les affichages dans l'ecran graphique et les evenement de la fenetre
event=WaitWindowEvent(5) ; attends de recevoir un evenements de la fenetre
WindowID = EventWindow() ;
EventType = EventType() ;
select event
; ********************************* regarde les evenements de gadget ***************************
Case #PB_Event_Gadget
Select EventGadget()
Case #Button_init ; on a appuyé sur le bouton..!!
Creation_map()
Case #vert
Case #horiz
EndSelect
Case #PB_Event_CloseWindow
End
Endselect
; ****************************************************************************
supr_horizontal()
supr_vertical()
supr_noirs()
generation_premiere_ligne()
;***************************************
; *****************************************
Forever
End
;- Zone Procedures
Procedure Open_Window()
;-Open_Window()
If OpenWindow(#Win, 20, 50, 640, 600, "Candy", #PB_Window_SystemMenu | #PB_Window_TitleBar ) ; on ouvre une fenetre
SmartWindowRefresh(#Win, #true)
TextGadget(#Titre, 250, 10, 100, 30, "Candy",#PB_Text_Center)
If LoadFont(#fonte_titre, "Arial", 24)
SetGadgetFont(#Titre, FontID(#fonte_titre)) ; la police par défaut est remplacée par celle chargée (Arial 16)
EndIf
TextGadget(#Auteur, 350, 30, 100, 20, "By Zorro",#PB_Text_Center)
TextGadget(#T_Score, 10, 50, 50, 20, "Score :",#PB_Text_Center)
TextGadget(#Score, 60, 50, 100, 20, "0000",#PB_Text_Center)
OpenWindowedScreen(windowID(#Win), 1, 100, x_larg, y_haut, 0, 1, 1) ; on creer un ecran graphique dedans
ButtonGadget(#Button_init, 30, 500, 100, 30, "Reinitialisation") ; on suprime les series de 3 horizontal et on compress
ContainerGadget(#Container, 160, 500,170, 50,#PB_Container_Single)
OptionGadget(#Vert, 1, 1, 160, 20, "^ echange vertical")
OptionGadget(#Horiz, 1, 30, 160, 20, "<> echange horizontal")
SetGadgetState(#Vert, #true)
CloseGadgetList()
SetWindowCallback(@WindowCallback())
EndIf
EndProcedure
;
Procedure Creation_map()
;- creaton tableau()
Flag_start=#true
RandomSeed(ElapsedMilliseconds())
For y=1 to 12
ligne$(y)=""
Next y
For y=1 to 12
For x=1 to 20
de=random(4,0)
ligne$(y)=ligne$(y)+str(de)
Next x
Next y
dessin() ; dessin du tableau
EndProcedure
Procedure echange_vertical(Lx,Ly)
;- echange Vertical de dalle()
If Ly>1
car_bas$=mid(ligne$(Ly),Lx,1)
car_haut$=mid(ligne$(Ly-1),Lx,1)
replacestring( ligne$(ly),car_bas$,car_haut$ ,#PB_String_InPlace,Lx,1)
replacestring( ligne$(ly-1),car_haut$,car_bas$ ,#PB_String_InPlace,Lx,1)
Endif
EndProcedure
Procedure echange_Horizontal(Lx,Ly)
;- echange Horizontal de dalle()
If Lx<20
car_bas$=mid(ligne$(Ly),Lx,1)
car_droit$=mid(ligne$(Ly),Lx+1,1)
replacestring( ligne$(ly),car_bas$,car_droit$ ,#PB_String_InPlace,Lx,1)
replacestring( ligne$(ly),car_droit$,car_bas$ ,#PB_String_InPlace,Lx+1,1)
Endif
EndProcedure
Procedure dessin()
;-Dessin()
StartDrawing(ScreenOutput())
For y=1 to 12
For x=1 to 20
nbr$=Mid(ligne$(y),x,1)
DrawImage(imageId(val(nbr$)),xj,yj)
xj=xj+32
Next x
xj=0
yj=yj+32
Next y
StopDrawing()
FlipBuffers() ; execute l'affichage
If Flag_start=#false
SetGadgetText(#Score, str(score.i))
Endif
EndProcedure
Procedure supr_horizontal()
;- supr_horizontal
; test horizontale verifie si 3 images semblable se suivent
; si c'est le cas on remplace par des case noires (0)
For i=1 to 12 ; pour chaque lignes
If FindString(ligne$(i),"111")
ligne$(i)=ReplaceString(ligne$(i),"111","000")
if Flag_start=#false
Score.i=Score.i+3
Endif
Endif
If FindString(ligne$(i),"222")
ligne$(i)=ReplaceString(ligne$(i),"222","000")
if Flag_start=#false
Score.i=Score.i+3
Endif
Endif
If FindString(ligne$(i),"333")
ligne$(i)=ReplaceString(ligne$(i),"333","000")
if Flag_start=#false
Score.i=Score.i+3
Endif
Endif
If FindString(ligne$(i),"444")
ligne$(i)=ReplaceString(ligne$(i),"444","000")
if Flag_start=#false
Score.i=Score.i+3
Endif
Endif
Next i
dessin()
EndProcedure
Procedure supr_vertical()
;- supr_Vertical
For x=1 to 20
For y=1 to 12
car1$=mid(ligne$(y),x,1)
car2$=mid(ligne$(y+1),x,1)
car3$=mid(ligne$(y+2),x,1)
If car1$<>"0"
If car3$=car2$ and car3$=car1$
replacestring( ligne$(y),car1$,"0",#PB_String_InPlace,x,1)
replacestring( ligne$(y+1),car2$,"0",#PB_String_InPlace,x,1)
replacestring( ligne$(y+2),car3$,"0" ,#PB_String_InPlace,x,1)
if Flag_start=#false
Score.i=Score.i+3
Endif
Endif
Endif
Next y
Next x
Endprocedure
Procedure supr_noirs()
;-Supr_noirs
; ; descente si noire dessous
For y=12 to 2 step -1 ; pour chaque lignes (on part du bas)
For x=1 to 20 ; pour chaque image
car_bas$=mid(ligne$(y),x,1)
car_haut$=mid(ligne$(y-1),x,1)
if car_bas$="0" ; image noire
Swap car_haut$,car_bas$
Endif
l1$=l1$+car_bas$
l2$=l2$+car_haut$
Next x
ligne$(y)=l1$ :l1$=""
ligne$(y-1)=l2$ :l2$=""
Next y
dessin()
EndProcedure
Procedure generation_premiere_ligne()
;-generation_1er_ligne
; remplacement des noirs de la premiere ligne suite a la descente
For x=1 to 20
de=random(4,1)
if mid(ligne$(1),x,1)="0"
replacestring( ligne$(1),"0",str(de) ,#PB_String_InPlace,x,1); on remplce le noirs de la premiere ligne
Endif
Next x
dessin()
EndProcedure
Procedure WindowCallback(WindowID, Message, wParam, lParam)
;-CallBack
Result = #PB_ProcessPureBasicEvents
Select Message
Case #WM_LBUTTONDOWN
Flag_start=#false
xm=(WindowMouseX(#win) )
ym=(WindowMouseY(#win) )
;dessin()
if ( xm<=x_larg ) and ( ym-100<=y_haut)
xx$="x="+str(((xm/32*20)/20+1/10)+1)
yy$="y="+str((((ym-100)/32*12)/12+1/10)+1)
;SetWindowTitle(#Win,xx$+" "+yy$)
SetWindowTitle(#Win,"By Zorro")
lx=((xm/32*20)/20+1/10)+1
ly=(((ym-100)/32*12)/12+1/10)+1
Endif
if GetGadgetState(#Vert)=#True
echange_vertical(Lx,Ly)
Else
echange_Horizontal(Lx,Ly)
Endif
Score.i=Score.i-20
if Score.i<=0
Score.i=0
MessageRequester("alerte","Vous avez perdu")
End
Endif
Case #WM_RBUTTONDOWN
Case #WM_KEYDOWN
if wParam =16 ; Shift gauche
flag_touche=-flag_touche
If flag_touche>0
SetGadgetState(#Vert, #true)
SetGadgetState(#Horiz, #False)
Else
SetGadgetState(#Horiz, #true)
SetGadgetState(#Vert, #False)
Endif
Endif
EndSelect
ProcedureReturn Result
EndProcedure
.
