PureBasic

Forums PureBasic - Français
https://www.purebasic.fr/french/

PunchAnabalt (source non punché)

https://www.purebasic.fr/french/viewtopic.php?t=14792

Page 1 sur 1

PunchAnabalt (source non punché)

Publié : lun. 15/sept./2014 0:18
par majikeyric
je vous livre à mon tour le source non punché de PunchAnabalt :)

Il fait presque 600 lignes.

Tous les fichiers sont disponibles ici : http://majikeyric.free.fr/wordpress/?wp ... 5ob3RsaW5r

A noter que j'avais aussi un programme qui était chargé de stocker dans l'image toutes les données
(map du niveau, attributs des tiles, animations, définitions des sprites, positions des obstacles, positions de départ du joueur, etc).

Code : Tout sélectionner

; PunchAnabalt by Majikeyric
; Right-Control to jump

EnableExplicit

;- Constantes

#L=640	; largeur écran
#H=480	; hauteur écran

#NbTiles=68
#NbSprites=46
#NbAnimations=5
#NbObstacles=16

; Attributs des tiles
#Solide_sur_le_dessous=1
#Solide_sur_le_dessus=2
#Solide_sur_la_droite=4
#Solide_sur_la_gauche=8

Enumeration
	#Course
	#Roulade
	#Saut
	#Chute
EndEnumeration

Enumeration
	#AnimCourse
	#AnimCourseRapide
	#AnimSaut
	#AnimChute
	#AnimRoulade
EndEnumeration

;- Variables

Structure Tile
	Sprite.i
	Attributs.i
EndStructure

Structure Obstacle
	X.f
	Y.f
	Collision.i
	Sprite.i
	Intensite.i
	VelocityY.f
EndStructure

Global.f JoueurX,JoueurY
Global.i JoueurEtat,JoueurSprite,JoueurCompteurAnim,JoueurIndiceAnim

Global Dim _map.i(15,512)
Global Dim sprites.i(#NbSprites)
Global Dim tiles.Tile(#NbTiles)
Global Dim animations.i(#NbAnimations,32)

Define.i i,j,x,y,l,h,zl,zh,k
Define.f velocityX,velocityY,gravity,accelerationX,pilonneX
Define.i tempo_acceleration,tempo_pilonne,tempo_avion,gameover,score,indicePosObstacles,avionX,dep,dx,dy,ox,b,tempo_score
Define t$

Dim xDepart.i(#NbTiles)
Dim posObstacles.Obstacle(#NbObstacles)
NewList Obstacles.Obstacle()

;- Procédures

Procedure Anime(a)
	
	Protected.i f
	
	f=0
	JoueurCompteurAnim-1
	
	If JoueurCompteurAnim=0
		
		JoueurCompteurAnim=animations(a,0)
		JoueurSprite=sprites(animations(a,JoueurIndiceAnim))
		JoueurIndiceAnim+1		
		
		If animations(a,JoueurIndiceAnim)=0
			f=1
			JoueurIndiceAnim=1
		EndIf
	EndIf
	ProcedureReturn f
	
EndProcedure

Procedure ChangeEtat(s)
	JoueurEtat=s
	JoueurCompteurAnim=1
	JoueurIndiceAnim=1
EndProcedure

Procedure PeutAllerDroite(x,y)
	
	Protected.i n,i,j,c
	
	n=(y+59)/32-y/32+1
	i = y/32
	j = (x+60-0)/32
	c=1
	While n>0 And c
		If tiles(_map(i,j))\Attributs & #Solide_sur_la_gauche
			c=0
		EndIf
		n-1
		i+1
	Wend
	
	ProcedureReturn c
	
EndProcedure

Procedure DeplacementMaxDroite(dm)
	
	Protected.i x,y,d,c
	
	x=JoueurX
	y=JoueurY
	d=0
	c=1
	While c And d<dm
		If PeutAllerDroite(x,y)
			x+1
			d+1
		Else
			c=0
		EndIf
	Wend
	
	ProcedureReturn d
	
EndProcedure

Procedure PeutAllerBas(x,y)
	
	Protected.i n,i,j,c
	
	n=(x+59)/32-x/32+1
	i=(y+60-0)/32
	j=x/32
	c=1
	While n>0 And c
		If tiles(_map(i,j))\Attributs & #Solide_sur_le_dessus
			c=0
		EndIf
		n-1
		j+1
	Wend
	
	ProcedureReturn c
	
EndProcedure

Procedure DeplacementMaxBas(dm)
	
	Protected.i x,y,d,c
	
	x=JoueurX
	y=JoueurY
	d=0
	c=1
	While c And d<dm
		If PeutAllerBas(x,y)
			y+1
			d+1
		Else
			c=0
		EndIf
	Wend
	
	ProcedureReturn d
	
EndProcedure

Procedure PeutAllerHaut(x,y)
	
	Protected.i n,i,j,c
	
	n=(x+59)/32-x/32+1
	i=(y-1+0)/32
	j=x/32
	c=1
	While n>0 And c
		If tiles(_map(i,j))\Attributs & #Solide_sur_le_dessous
			c=0
		EndIf
		n-1
		j+1
	Wend
	
	ProcedureReturn c
	
EndProcedure

Procedure DeplacementMaxHaut(dm)
	
	Protected.i x,y,d,c
	
	x=JoueurX
	y=JoueurY
	d=0
	c=1
	While c And d>dm
		If PeutAllerHaut(x,y)
			y-1
			d-1
		Else
			c=0
		EndIf
	Wend
	
	ProcedureReturn d
	
EndProcedure

;- Programme principal

UseOGGSoundDecoder()

InitKeyboard()
InitSound()
InitSprite()

OpenWindow(0,0,0,#L,#H,"PunchAnabalt by Majikeyric",#PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0),0,0,#L,#H)

LoadSound(0,"a.ogg")

TransparentSpriteColor(#PB_Default,$ff00ff) ; Magenta

LoadImage(0,"a.bmp")

;- Initialisation des données

StartDrawing(ImageOutput(0))

; Map data
For i=0 To 14
	For j=0 To 511
		_map(i,j)=Point(j,i+(512-15))
	Next
Next

; AnimationsData
For i=0 To #NbAnimations-1
	For j=0 To 31
		animations(i,j)=Point(j,i+(512-26-#NbAnimations))
	Next
Next

For i=0 To #NbObstacles-1
	posObstacles(i)\X=Point(i,512-26)
	posObstacles(i)\Y=Point(i,512-25)
	posObstacles(i)\Sprite=Point(i,512-24)
Next

StopDrawing()

StartDrawing(ScreenOutput())
DrawImage(ImageID(0),0,0)
StopDrawing()

;- Création des Sprites

i=0
Repeat
	StartDrawing(ImageOutput(0))
	x=Point(i,512-22)
	y=Point(i,512-21)
	l=Point(i,512-20)
	h=Point(i,512-19)
	zl=Point(i,512-18)	;ZoomLargeur
	zh=Point(i,512-17)	;ZoomHauteur
	StopDrawing()
	sprites(i)=GrabSprite(#PB_Any,x,y,l,h,#PB_Sprite_PixelCollision)
	ZoomSprite(sprites(i),zl,zh)
	i+1
Until i=#NbSprites

; Tiles images ,attributs et positions de départ du joueur

i=0
j=0
k=0
Repeat
	StartDrawing(ImageOutput(0))
	tiles(i)\Attributs=Point(i,512-16)
	xDepart(i)=Point(i,512-23)
	StopDrawing()
	tiles(i)\Sprite=GrabSprite(#PB_Any,j*32,k*32,32,32)
	
	i+1
	
	j+1
	If j=16
		j=0
		k+1
	EndIf
	
Until i=#NbTiles

ClearScreen(0)

Macro Init
	
	velocityX.f=2.0
	accelerationX.f=0.5
	velocityY.f = 0.0
	gravity.f = 0.5
	
	pilonneX=-88
	
	tempo_acceleration=1
	tempo_pilonne=1
	tempo_avion=1
	tempo_score=10
	
	gameover=0
	
	score=0
	
	ChangeEtat(#Chute)
	JoueurX=xDepart(Random(7))
	JoueurY=0
	
	indicePosObstacles=0
	While posObstacles(indicePosObstacles)\X<JoueurX-52
		indicePosObstacles+1
	Wend
	
EndMacro

PlaySound(0,#PB_Sound_Loop)

Init

Repeat
	
	Repeat
	Until WindowEvent()=0
	
	ExamineKeyboard()
	
	If Not gameover
		
		tempo_pilonne-1
		If tempo_pilonne=0
			tempo_pilonne=450
			pilonneX.f=800
		EndIf
		
		tempo_avion-1
		If tempo_avion=0
			tempo_avion=1000
			avionX=2000
		EndIf
		
		tempo_score-1
		If tempo_score=0
			tempo_score=10
			score+1
		EndIf
		
		tempo_acceleration-1
		If tempo_acceleration=0
			tempo_acceleration=25
			If velocityX<20
				velocityX+accelerationX
			EndIf
		EndIf
		
		dep=DeplacementMaxDroite(velocityX)
		If dep<>velocityX
			velocityX=dep
		EndIf
		
		Select JoueurEtat
				
			Case #Course,#Roulade
				
				dep=DeplacementMaxBas(1)
				If dep=1
					ChangeEtat(#Chute)
					velocityY=0
				ElseIf KeyboardPushed(#PB_Key_RightControl)
					ChangeEtat(#Saut)
					velocityY=-10
				EndIf
				If JoueurEtat=#Roulade
					If Anime(#AnimRoulade)
						ChangeEtat(#Course)
					EndIf
				Else;if JoueurEtat=#Course
					If velocityX>10
						Anime(#AnimCourseRapide)
					Else
						Anime(#AnimCourse)
					EndIf
				EndIf
				
			Case #Saut
				
				If KeyboardReleased(#PB_Key_RightControl) And velocityY<-4
					velocityY=-4
				EndIf
				
				velocityY + gravity
				
				If velocityY<0
					dep=DeplacementMaxHaut(velocityY)
					If dep<>velocityY
						changeEtat(#Chute)
					EndIf
					JoueurY+dep
				Else
					ChangeEtat(#Chute)
					JoueurY+velocityY
				EndIf
				
				Anime(#AnimSaut)
				
			Case #Chute
				
				velocityY + gravity
				dep=DeplacementMaxBas(velocityY)
				If dep<>velocityY
					If velocityY>10
						ChangeEtat(#Roulade)
					Else
						ChangeEtat(#Course)
					EndIf
				EndIf
				JoueurY+dep
				
				Anime(#AnimChute)
				
		EndSelect
		
		
		ForEach Obstacles()
			If Not Obstacles()\Collision
				
				; Le joueur est rentré en collision avec un obstacle ?
				
				If SpritePixelCollision(JoueurSprite,JoueurX+velocityX,JoueurY,Obstacles()\Sprite,Obstacles()\X,Obstacles()\Y)
					Obstacles()\Collision=1
					Obstacles()\Intensite=140
					ChangeEtat(#Roulade)
					velocityX-3
					If velocityX<1
						velocityX=1
					EndIf
				EndIf
			Else
				;Obstacles()\Intensite=Random(255)
				Obstacles()\VelocityY+gravity
				Obstacles()\Y+Obstacles()\VelocityY
			EndIf
		Next
		
		JoueurX+velocityX
		If JoueurX>=15728	; Si le joueur est arrivé 1 écran avant la fin du niveau
			JoueurX-15728	; on le repositionne au début (le dernier écran est identique au premier)
		EndIf				; -> on croit que le niveau est sans fin
		
		If avionX>-2000
			dy=Random(24)-12	; <-- Produit les tremblements de l'écran quand l'avion passe (dy=décalage en Y)
			ClearScreen(0)
		Else
			dy=0
		EndIf
		
	EndIf
	
	; affichage de l'arrière-plan
	
	DisplaySprite(sprites(0),0,dy)
	
	If Not gameover
		
		; Affichage de l'avion
		
		If avionX>-2000
			If avionX>-284 And avionX<640 ; FIX (bug sprite PB 5.30)
				DisplayTransparentSprite(sprites(40),avionX,60)
			EndIf ; FIX
			
			avionX-20
		EndIf
		
	EndIf
	
	; Affichage du décor
	
	ox=JoueurX-16
	x=ox/32:dx=ox%32
	
	For i=0 To 14
		For j=0 To 20
			b=_map(i,x+j)
			If b
				DisplayTransparentSprite(tiles(b)\Sprite,j*32-dx,i*32+dy)
			EndIf
		Next
	Next
	
	If Not gameover
		
		; affichage des obstacles ou suppression de la liste si hors de l'écran
		
		ForEach Obstacles()
			If Obstacles()\X<ox-36 Or Obstacles()\X>ox+640 Or Obstacles()\Y>#H
				DeleteElement(Obstacles())
			Else
				DisplayTransparentSprite(Obstacles()\Sprite,Obstacles()\X-ox,Obstacles()\Y+dy,Obstacles()\Intensite)
			EndIf
		Next
		
		; affichage du joueur
		DisplayTransparentSprite(JoueurSprite,JoueurX-ox,JoueurY+dy)
		
		; affichage du pilone
		If pilonneX>-88
			If pilonneX<640 ;FIX (bug sprite PB 5.30)
				DisplayTransparentSprite(sprites(1),pilonneX,dy)
			EndIf ; FIX
			pilonneX-velocityX*2
		EndIf
		
		; Affichage du score
		StartDrawing(ScreenOutput())
		t$=Str(score)+"m"
		DrawText(640-TextWidth(t$),0,t$)
		StopDrawing()
		
		; si le joueur est en bas de l'écran (chute) : game over
		If JoueurY>419
			gameover=1
		EndIf	
		
		; Ajout d'obstacles dans la liste en fonction de la position du joueur dans le décor
		While posObstacles(indicePosObstacles)\X>ox-36 And posObstacles(indicePosObstacles)\X<ox+640
			AddElement(Obstacles())
			Obstacles()\X=posObstacles(indicePosObstacles)\X
			Obstacles()\Y=posObstacles(indicePosObstacles)\Y
			Obstacles()\Sprite=sprites(posObstacles(indicePosObstacles)\Sprite)
			Obstacles()\Collision=0
			Obstacles()\VelocityY=0
			Obstacles()\Intensite=255
			indicePosObstacles+1
			indicePosObstacles % #NbObstacles
		Wend
		
	Else
		; Affichage du game over
		DisplayTransparentSprite(sprites(45),125,175)
		StartDrawing(ScreenOutput())
		DrawText(204,235,"You ran "+score+" meters before dying.")
		StopDrawing()
		If KeyboardPushed(#PB_Key_RightControl)
			Init
		EndIf
		
	EndIf
	
	FlipBuffers()
	
Until KeyboardPushed(#PB_Key_Escape)

Re: PunchAnabalt (source non punché)

Publié : lun. 15/sept./2014 9:36
par raven
Ce code,est un petit bijoux 8)
oldschool powerrr...

merci Majikeric et encore bravo pour ta belle production :)

Re: PunchAnabalt (source non punché)

Publié : lun. 15/sept./2014 13:02
par Huitbit
Hello,

Merci pour ce code bien propre et félicitations pour le punch.

En un an tu as apporté pas mal de codes très utiles,
il faudrait ajouter le prix de "rookie of the year" (mais vu ton CV, le terme est bien mal choisi ! :lol: )

Hasta la vista !

Re: PunchAnabalt (source non punché)

Publié : lun. 15/sept./2014 20:46
par majikeyric
Merci à vous :)
Huitbit a écrit : En un an tu as apporté pas mal de codes très utiles,
J'ai pourtant pas publié grand chose :mrgreen: :lol:
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru