A l'aide !!!
Publié : ven. 23/avr./2004 18:20
Bonjour à tous.
Je suis nouveau dans la programmation en Pure Basic même si mes débuts en langage Basic date de l’Atari. Je voulais réaliser pour mon gamin un petit jeu style cascade qui était présent sur les ordinateurs « Révo » de Psion. Je me suis dit « Facile », avec Pure Basic c’est l’affaire de quelques heures. Et bien j’en suis à quelques jours et je m’arrache les cheveux (le peu qui me reste…) pour arriver à comprendre pourquoi ce damné programme ne fonctionne pas.
Le but du jeu est assez simple. On clique sur une boule de couleur et toutes les boules de même couleur disparaissent. Les boules situées au-dessus tombent par gravité pour combler les vides.
Ne riez pas en voyant mon listing, je suis sûr que l’on peu l’améliorer. Ce que je ne comprends pas c’est pourquoi l’affichage ne suit pas le programme. J’ai tapé le même listing en l’adaptant sur excel et cela fonctionne parfaitement. Dans Pure Basic il semblerai que le rafraîchissement de l’image ne se fait pas correctement ou alors que la gestion de la souris me pose quelques problèmes ainsi que l’emplacement du flipbuffers. Mais même en insérant un delay(300) cela ne résout pas le problème…
Mis à part le problème de l’affichage je n’arrive pas à trouver un algorithme qui me permette d’enlever toutes les boules qui se touchent. Mon listing ne permet à l’heure actuelle de n’enlever que les boules qui sont sur la même ligne ou la même colonne. On m’a parlé de fonction récursive mais alors là…J’en perd mon latin.
Si vous pouviez me donner un petit coup de main sur ce programme je vous en remercie par avance. Je joins le listing que j’ai simplifié au niveau de la fabrication des sprites pour que le programme puisse fonctionner sans chargement d’images.
André
Dim tableau_jeu(10,25)
Dim buf.b(10)
InitSprite()
InitKeyboard()
InitMouse()
InitSound()
OpenScreen(1024,768,16,"Cascade")
CreateSprite(0,32,32,0)
StartDrawing(SpriteOutput(0))
Box(0,0,32,32,RGB(255,255,255))
StopDrawing()
CreateSprite(1,32,32,1)
StartDrawing(SpriteOutput(1))
Box(0,0,32,32,RGB(255,255,255))
FrontColor(255,0,0)
Circle(16,16,16)
StopDrawing()
CreateSprite(2,32,32,1)
StartDrawing(SpriteOutput(2))
Box(0,0,32,32,RGB(255,255,255))
FrontColor(0,0,255)
Circle(16,16,16)
StopDrawing()
CreateSprite(3,32,32,1)
StartDrawing(SpriteOutput(3))
Box(0,0,32,32,RGB(255,255,255))
FrontColor(0,0,0)
Circle(16,16,16)
StopDrawing()
LoadSound(0,"C:\data\catch.wav")
LoadSound(1,"C:\data\blip.wav")
LoadFont(1,"arial",20)
Global cb.b,l.b,c.b,nb.s,x,y,im,res.b,hdl,px,py,li,co,ncoul.b,z,cptl.b,k,ligne.s,posy.l,lettre.s,boutonclick.b
couleur.b
Procedure boule(couleur)
cb=0
Repeat
l=Random(8)+1
c=Random(24)+1
If tableau_jeu(l,c)=0
tableau_jeu(l,c)=couleur
cb=cb+1
a=a+1
EndIf
Until cb=75
EndProcedure
Procedure init_tableau()
For l=1 To 9
For c=1 To 25
tableau_jeu(l,c)=0
Next c
Next l
EndProcedure
Global txtx.l,txty.l,txt.s
; remplissage du tableau avec les boules de couleurs
init_tableau()
couleur=1
boule(couleur);boules rouges
couleur=2
boule(couleur);boules bleus
couleur=3
boule(couleur);boules noires
Gosub Dessin_jeu
Repeat
ExamineKeyboard()
ExamineMouse()
FlipBuffers()
Gosub Dessin_jeu
px=MouseX()
py=MouseY()
co=((px-100)/32)+1
li=((py-100)/32)+1
StartDrawing(ScreenOutput())
Circle(MouseX(),MouseY(),2,RGB(0,0,0))
StopDrawing()
boutonclick=MouseButton(1)
If boutonclick=1
Delay(600)
boutonclick=0
ncoul=tableau_jeu(li,co)
;tableau_jeu(li,co)=0
PlaySound(1)
Gosub Analyse
Gosub Mise_a_jour
EndIf
Until KeyboardReleased(#PB_Key_Escape)
End
Dessin_jeu:
StartDrawing(ScreenOutput())
DrawingMode(1)
Box(0,0,1024,768,RGB($FF,$FF,$FF))
FrontColor(255,0,0)
UseFont(1)
DrawingFont(FontID())
Locate (860,10)
DrawText("SCORE")
x=100:y=100
StopDrawing()
For l=1 To 9
For c=1 To 25
im=(tableau_jeu(l,c))
DisplaySprite(im,x,y)
x=x+32
Next c
x=100
y=y+32
Next l
Return
Mise_a_jour:
cptl = 1
restl = 0
For k = 1 To 9
buf(k) = 0
Next k
For c = 1 To 25
cptl = 1
For l = 1 To 9
cptl = 1
If tableau_jeu(l, c) = 0
For k = 1 To 9
If tableau_jeu(k, c) <> 0
buf(cptl) = tableau_jeu(k, c)
cptl = cptl + 1
tableau_jeu(k, c) = 0
EndIf
Next k
restl = cptl - 1
For k = 9 To 9 - restl Step -1
tableau_jeu(k, c) = buf(restl)
restl = restl - 1
Next k
EndIf
Next l
For k = 1 To 9
buf(k) = 0
Next k
Next c
Return
; Analyse du tableau pour retirer les boules de même couleur.
Analyse:
For k = li To 1 Step -1
If tableau_jeu(k, co) <> ncoul
Break
Else
tableau_jeu(k, co) = 0
EndIf
Next k
For k = li + 1 To 9
If tableau_jeu(k, co) <> ncoul
Break
Else
tableau_jeu(k, co) = 0
EndIf
Next k
For k = co - 1 To 1 Step -1
If tableau_jeu(li, k) <> ncoul
Break
Else
tableau_jeu(li, k) = 0
EndIf
Next k
For k = co + 1 To 25
If tableau_jeu(li, k) <> ncoul
Break
Else
tableau_jeu(li, k) = 0
EndIf
Next k
Return
Je suis nouveau dans la programmation en Pure Basic même si mes débuts en langage Basic date de l’Atari. Je voulais réaliser pour mon gamin un petit jeu style cascade qui était présent sur les ordinateurs « Révo » de Psion. Je me suis dit « Facile », avec Pure Basic c’est l’affaire de quelques heures. Et bien j’en suis à quelques jours et je m’arrache les cheveux (le peu qui me reste…) pour arriver à comprendre pourquoi ce damné programme ne fonctionne pas.
Le but du jeu est assez simple. On clique sur une boule de couleur et toutes les boules de même couleur disparaissent. Les boules situées au-dessus tombent par gravité pour combler les vides.
Ne riez pas en voyant mon listing, je suis sûr que l’on peu l’améliorer. Ce que je ne comprends pas c’est pourquoi l’affichage ne suit pas le programme. J’ai tapé le même listing en l’adaptant sur excel et cela fonctionne parfaitement. Dans Pure Basic il semblerai que le rafraîchissement de l’image ne se fait pas correctement ou alors que la gestion de la souris me pose quelques problèmes ainsi que l’emplacement du flipbuffers. Mais même en insérant un delay(300) cela ne résout pas le problème…
Mis à part le problème de l’affichage je n’arrive pas à trouver un algorithme qui me permette d’enlever toutes les boules qui se touchent. Mon listing ne permet à l’heure actuelle de n’enlever que les boules qui sont sur la même ligne ou la même colonne. On m’a parlé de fonction récursive mais alors là…J’en perd mon latin.
Si vous pouviez me donner un petit coup de main sur ce programme je vous en remercie par avance. Je joins le listing que j’ai simplifié au niveau de la fabrication des sprites pour que le programme puisse fonctionner sans chargement d’images.
André
Dim tableau_jeu(10,25)
Dim buf.b(10)
InitSprite()
InitKeyboard()
InitMouse()
InitSound()
OpenScreen(1024,768,16,"Cascade")
CreateSprite(0,32,32,0)
StartDrawing(SpriteOutput(0))
Box(0,0,32,32,RGB(255,255,255))
StopDrawing()
CreateSprite(1,32,32,1)
StartDrawing(SpriteOutput(1))
Box(0,0,32,32,RGB(255,255,255))
FrontColor(255,0,0)
Circle(16,16,16)
StopDrawing()
CreateSprite(2,32,32,1)
StartDrawing(SpriteOutput(2))
Box(0,0,32,32,RGB(255,255,255))
FrontColor(0,0,255)
Circle(16,16,16)
StopDrawing()
CreateSprite(3,32,32,1)
StartDrawing(SpriteOutput(3))
Box(0,0,32,32,RGB(255,255,255))
FrontColor(0,0,0)
Circle(16,16,16)
StopDrawing()
LoadSound(0,"C:\data\catch.wav")
LoadSound(1,"C:\data\blip.wav")
LoadFont(1,"arial",20)
Global cb.b,l.b,c.b,nb.s,x,y,im,res.b,hdl,px,py,li,co,ncoul.b,z,cptl.b,k,ligne.s,posy.l,lettre.s,boutonclick.b
couleur.b
Procedure boule(couleur)
cb=0
Repeat
l=Random(8)+1
c=Random(24)+1
If tableau_jeu(l,c)=0
tableau_jeu(l,c)=couleur
cb=cb+1
a=a+1
EndIf
Until cb=75
EndProcedure
Procedure init_tableau()
For l=1 To 9
For c=1 To 25
tableau_jeu(l,c)=0
Next c
Next l
EndProcedure
Global txtx.l,txty.l,txt.s
; remplissage du tableau avec les boules de couleurs
init_tableau()
couleur=1
boule(couleur);boules rouges
couleur=2
boule(couleur);boules bleus
couleur=3
boule(couleur);boules noires
Gosub Dessin_jeu
Repeat
ExamineKeyboard()
ExamineMouse()
FlipBuffers()
Gosub Dessin_jeu
px=MouseX()
py=MouseY()
co=((px-100)/32)+1
li=((py-100)/32)+1
StartDrawing(ScreenOutput())
Circle(MouseX(),MouseY(),2,RGB(0,0,0))
StopDrawing()
boutonclick=MouseButton(1)
If boutonclick=1
Delay(600)
boutonclick=0
ncoul=tableau_jeu(li,co)
;tableau_jeu(li,co)=0
PlaySound(1)
Gosub Analyse
Gosub Mise_a_jour
EndIf
Until KeyboardReleased(#PB_Key_Escape)
End
Dessin_jeu:
StartDrawing(ScreenOutput())
DrawingMode(1)
Box(0,0,1024,768,RGB($FF,$FF,$FF))
FrontColor(255,0,0)
UseFont(1)
DrawingFont(FontID())
Locate (860,10)
DrawText("SCORE")
x=100:y=100
StopDrawing()
For l=1 To 9
For c=1 To 25
im=(tableau_jeu(l,c))
DisplaySprite(im,x,y)
x=x+32
Next c
x=100
y=y+32
Next l
Return
Mise_a_jour:
cptl = 1
restl = 0
For k = 1 To 9
buf(k) = 0
Next k
For c = 1 To 25
cptl = 1
For l = 1 To 9
cptl = 1
If tableau_jeu(l, c) = 0
For k = 1 To 9
If tableau_jeu(k, c) <> 0
buf(cptl) = tableau_jeu(k, c)
cptl = cptl + 1
tableau_jeu(k, c) = 0
EndIf
Next k
restl = cptl - 1
For k = 9 To 9 - restl Step -1
tableau_jeu(k, c) = buf(restl)
restl = restl - 1
Next k
EndIf
Next l
For k = 1 To 9
buf(k) = 0
Next k
Next c
Return
; Analyse du tableau pour retirer les boules de même couleur.
Analyse:
For k = li To 1 Step -1
If tableau_jeu(k, co) <> ncoul
Break
Else
tableau_jeu(k, co) = 0
EndIf
Next k
For k = li + 1 To 9
If tableau_jeu(k, co) <> ncoul
Break
Else
tableau_jeu(k, co) = 0
EndIf
Next k
For k = co - 1 To 1 Step -1
If tableau_jeu(li, k) <> ncoul
Break
Else
tableau_jeu(li, k) = 0
EndIf
Next k
For k = co + 1 To 25
If tableau_jeu(li, k) <> ncoul
Break
Else
tableau_jeu(li, k) = 0
EndIf
Next k
Return
.
