PureBasic

Salut,

Bon, j'avais fait ceci il y a un fort long bout de temps

Un serpent de boule qui suis la souris, c'est assez rigolo

Code : Tout sélectionner

; Auteur : Le Soldat Inconnu
; Version de PB : 3.90
; 
; Explication du programme :
; Dessiner un serpent de boule qui suit la souris

; Dimension du screen
#EcranX = 1024
#EcranY= 768

#NbBoule = 100 ; Nombre de boule
#RayonBoule = 17 ; diamètre des boules

#Vitesse = 0.2 ; Vitesse de déplacement des boules

Structure BouleInfo ; Contient la position de chaque boule
  x.f
  y.f
EndStructure
Dim Boule.BouleInfo(#NbBoule)

Procedure DessineBoule(id, Couleur)
  ; ID : Identifiant du sprite
  ; Couleur : Couleur RGB de la boule

  CreateSprite(id, #RayonBoule * 2 + 1, #RayonBoule * 2 + 1)
  StartDrawing(SpriteOutput(id))
    Circle(#RayonBoule, #RayonBoule, #RayonBoule, Couleur) ; On dessine une boule
  StopDrawing()
  
EndProcedure


InitSprite()
InitKeyboard()
InitMouse()
OpenScreen(#EcranX, #EcranY, 32, "")

SetFrameRate(50)

; On crée les sprites qui représentent des boules de couleur de plus en plus claires
For n = 0 To #NbBoule
  Coef.f = n / #NbBoule
  DessineBoule(n, RGB(255, 165 + (255 - 165) * Coef, 255 * Coef))
Next

; On place la souris au point de départ
MouseLocate(#RayonBoule, #RayonBoule)

Repeat
  ExamineMouse()
  ExamineKeyboard()
  
  ClearScreen(0) ; On efface l'écran
  
  ; Position de la première boule que l'on calcule avec la souris
  ; Il s'agit de la boule 0
  Boule(0)\x = MouseX() - #RayonBoule
  Boule(0)\y = MouseY() - #RayonBoule
  
  For n = #NbBoule To 1 Step -1 ; Pour chaque boule
    ; On part de la fin afin que la dernière boule soit en dessous des autres
  
    ; On calcul la vitesse de déplacement en x de la boule à partir de la distance entre cette boule et la précédente
    ; Le but est de permettre à cette boule de suivre la précédente
    ; Et plus la distance entre ces 2 boules est grande et plus elle ira vite pour la rattraper
    VitesseX.f = (Boule(n - 1)\x - Boule(n)\x) * #Vitesse
    
    ; De même sur les y
    VitesseY.f = (Boule(n - 1)\y - Boule(n)\y) * #Vitesse
    
    ; On détermine la nouvelle position de la boule
    Boule(n)\x + VitesseX
    Boule(n)\y + VitesseY
    
    ; On affiche la boule
    DisplayTransparentSprite(n, Boule(n)\x, Boule(n)\y)
    
  Next
  
  DisplayTransparentSprite(0, Boule(0)\x, Boule(0)\y) ; On affiche la boule qui représente la souris
  ; Elle est affiché en dernier pour être au dessus des autres
  
  FlipBuffers()
  
Until KeyboardPushed(#PB_Key_Escape)

J'ai réussi à faire un code pour qui se déplace tout seul d'un point à un autre en respectant une vitesse de courbure maximum (en gros, il fait pas de ligne directe, il doit prendre un virage comme une voiture)

Code : Tout sélectionner

; Auteur : Le Soldat Inconnu
; Version de PB : 3.90
; 
; Explication du programme :
; Dessiner un serpent de boule qui suit la souris

; Dimension du screen
#EcranX = 1024
#EcranY= 768

#NbBoule = 100 ; Nombre de boule
#RayonBoule = 17 ; diamètre des boules

#Vitesse = 0.2 ; Vitesse de déplacement des boules

#Tete_Rotation = 2 * #PI / 120 ; Vitesse pour changer de direction de la tete du serpent
#Tete_Vitesse = 10 ; Vitesse maximum de la tete du serpent
Tete_Angle.f = 0
Tete_X.f = 0
Tete_Y.f = 0
Deplacement_X = 0
Deplacement_Y = 0

Structure BouleInfo ; Contient la position de chaque boule
  x.f
  y.f
EndStructure
Dim Boule.BouleInfo(#NbBoule)

Procedure DessineBoule(id, Couleur)
  ; ID : Identifiant du sprite
  ; Couleur : Couleur RGB de la boule

  CreateSprite(id, #RayonBoule * 2 + 1, #RayonBoule * 2 + 1)
  StartDrawing(SpriteOutput(id))
    Circle(#RayonBoule, #RayonBoule, #RayonBoule, Couleur) ; On dessine une boule
  StopDrawing()
  
EndProcedure


InitSprite()
InitKeyboard()
InitMouse()
OpenScreen(#EcranX, #EcranY, 32, "")

SetFrameRate(50)

; On crée les sprites qui représentent des boules de couleur de plus en plus claires
For n = 0 To #NbBoule
  Coef.f = n / #NbBoule
  DessineBoule(n, RGB(255, 165 + (255 - 165) * Coef, 255 * Coef))
Next




Repeat
  ExamineMouse()
  ExamineKeyboard()
  
  ClearScreen(0) ; On efface l'écran
  
  ; Position de la première boule que l'on calcule
  ; Il s'agit de la boule 0
  
  If Distance.f < #Tete_Vitesse ; Si on est arrivé, on va vers un autre point en aléatoire
    Deplacement_X = Random(#EcranX)
    Deplacement_Y = Random(#EcranY)
  EndIf
  If Distance < #Tete_Vitesse * 40 ; Si on arrive pas à atteindre le point au bout d'un moment, on dis qu'on l'a eu
    Compteur_Proche + 1
    If Compteur_Proche > 200
      Deplacement_X = Random(#EcranX)
      Deplacement_Y = Random(#EcranY)
    EndIf
  Else
    Compteur_Proche = 0
  EndIf
  
  ; Distance entre la boule et le point visé
  Distance.f = Sqr((Deplacement_X - Tete_X) * (Deplacement_X - Tete_X) + (Deplacement_Y - Tete_Y) * (Deplacement_Y - Tete_Y))
  
  ; Angle entre la boule et le point visé
  If Deplacement_X >= Tete_X And Deplacement_Y >= Tete_Y ; entre 0 et Pi/2
    Angle.f = ACos((Deplacement_X - Tete_X) / Distance)
  ElseIf Deplacement_X >= Tete_X And Deplacement_Y <= Tete_Y ; entre 0 et -Pi/2
    Angle.f = -ACos((Deplacement_X - Tete_X) / Distance)
  ElseIf Deplacement_X <= Tete_X And Deplacement_Y >= Tete_Y ; entre Pi/2 et Pi
    Angle.f = #PI - ACos((Tete_X - Deplacement_X) / Distance)
  Else ; entre -Pi/2 et -Pi
    Angle.f = -#PI + ACos((Tete_X - Deplacement_X) / Distance)
  EndIf
  
  If Tete_Angle > #PI ; Si l'angle est plus grand que #Pi ou plus petit que -#Pi, on le ramene est -#pi et #pi
    Tete_Angle - 2 * #PI
  EndIf
  If Tete_Angle < -#PI
    Tete_Angle + 2 * #PI
  EndIf
  
  If Tete_Angle >= Angle ; on regarde dans quel sens on doit faire évoluer l'angle
    If Tete_Angle - Angle > #PI
      Tete_Angle + #Tete_Rotation
    Else
      Tete_Angle - #Tete_Rotation
    EndIf
  Else
    If Angle - Tete_Angle > #PI
      Tete_Angle - #Tete_Rotation
    Else
      Tete_Angle + #Tete_Rotation
    EndIf
  EndIf
  
  Tete_X + Cos(Tete_Angle) * #Tete_Vitesse ; On déplace suivant l'angle
  Tete_Y + Sin(Tete_Angle) * #Tete_Vitesse
  
  Boule(0)\x = Tete_X - #RayonBoule
  Boule(0)\y = Tete_Y - #RayonBoule
   
  For n = #NbBoule To 1 Step -1 ; Pour chaque boule
    ; On part de la fin afin que la dernière boule soit en dessous des autres
  
    ; On calcul la vitesse de déplacement en x de la boule à partir de la distance entre cette boule et la précédente
    ; Le but est de permettre à cette boule de suivre la précédente
    ; Et plus la distance entre ces 2 boules est grande et plus elle ira vite pour la rattraper
    VitesseX.f = (Boule(n - 1)\x - Boule(n)\x) * #Vitesse
    
    ; De même sur les y
    VitesseY.f = (Boule(n - 1)\y - Boule(n)\y) * #Vitesse
    
    ; On détermine la nouvelle position de la boule
    Boule(n)\x + VitesseX
    Boule(n)\y + VitesseY
    
    ; On affiche la boule
    DisplayTransparentSprite(n, Boule(n)\x, Boule(n)\y)
    
  Next
  
  DisplayTransparentSprite(0, Boule(0)\x, Boule(0)\y) ; On affiche la boule qui représente la souris
  ; Elle est affiché en dernier pour être au dessus des autres
  
  FlipBuffers()

Until KeyboardPushed(#PB_Key_Escape)

On doit pouvoir en faire un écran de veille sympa

Très sympa ces codes. J'avais aussi fait un truc qui tenait compte de l'angle de rotation d'un avion, et j'avais un problème à résoudre, faudra que je m'inspire de ton code, il y a peut-être la solution

http://www.purebasic.fr/french/viewtopic.php?t=6587

Héhé, ça me rappelle une très bonne intro de alpha flight (ça date!). Il y avait en général un mouvement ajouté à la position de façon à ce que l'on ait l'impression que tout le serpent soit animé. En tous cas, c'est excellent, merci; on dirait que t'as bien bossé sur le 2ème code

Bonjour à tous.

Je n'avais pas grand chose à faire alors je fais quelques petites modification au code original.
Les modifications effectuées :

1 - Ajout d'étoile filante en arrière plan
2 - Possibilité d'ajouter plusieurs serpents en même temps

Chose à corriger :

1 - Le dégradé de couleur d'une boule à l'autre

Je retourne le code modifié

A+
Guimauve

Code : Tout sélectionner

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Nom du projet : Balls Snake Demo
; Fichier : Balls Snake - Main.pb
; Version : 1.0.0
; Programmation : OK
; Programmé par : Le Soldat Inconnu
; Modifié par Guimauve
; Date : 06-09-2009
; Mise à jour : 16-09-2009
; Codé avec PureBasic V4.40
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Constantes de dimensionnement <<<<<

#STARFIELD_STAR_MAX = 2000
#SNAKE_BALLS_MAX = 100

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Déclaration de la Structure <<<<<

Structure StarField
  
  ScreenWidth.w
  ScreenHeight.w
  SpeedMin.f
  Speed.f[#STARFIELD_STAR_MAX]
  PosX.f[#STARFIELD_STAR_MAX]
  PosY.f[#STARFIELD_STAR_MAX]
  PosZ.f[#STARFIELD_STAR_MAX]
  
EndStructure

Macro GetStarFieldScreenWidth(StarFieldA)
  
  StarFieldA\ScreenWidth
  
EndMacro

Macro GetStarFieldScreenHeight(StarFieldA)
  
  StarFieldA\ScreenHeight
  
EndMacro

Macro GetStarFieldSpeedMin(StarFieldA)
  
  StarFieldA\SpeedMin
  
EndMacro

Macro GetStarFieldSpeed(StarFieldA, Index)
  
  StarFieldA\Speed[Index]
  
EndMacro

Macro GetStarFieldPosX(StarFieldA, Index)
  
  StarFieldA\PosX[Index]
  
EndMacro

Macro GetStarFieldPosY(StarFieldA, Index)
  
  StarFieldA\PosY[Index]
  
EndMacro

Macro GetStarFieldPosZ(StarFieldA, Index)
  
  StarFieldA\PosZ[Index]
  
EndMacro

Macro SetStarFieldScreenWidth(StarFieldA, P_ScreenWidth)
  
  GetStarFieldScreenWidth(StarFieldA) = P_ScreenWidth
  
EndMacro

Macro SetStarFieldScreenHeight(StarFieldA, P_ScreenHeight)
  
  GetStarFieldScreenHeight(StarFieldA) = P_ScreenHeight
  
EndMacro

Macro SetStarFieldSpeedMin(StarFieldA, P_SpeedMin)
  
  GetStarFieldSpeedMin(StarFieldA) = P_SpeedMin
  
EndMacro

Macro SetStarFieldSpeed(StarFieldA, Index, P_Speed)
  
  GetStarFieldSpeed(StarFieldA, Index) = P_Speed
  
EndMacro

Macro SetStarFieldPosX(StarFieldA, Index, P_PosX)
  
  GetStarFieldPosX(StarFieldA, Index) = P_PosX
  
EndMacro

Macro SetStarFieldPosY(StarFieldA, Index, P_PosY)
  
  GetStarFieldPosY(StarFieldA, Index) = P_PosY
  
EndMacro

Macro SetStarFieldPosZ(StarFieldA, Index, P_PosZ)
  
  GetStarFieldPosZ(StarFieldA, Index) = P_PosZ
  
EndMacro

Macro ResetStarField(StarFieldA)
  
  SetStarFieldScreenWidth(StarFieldA, 0)
  SetStarFieldScreenHeight(StarFieldA, 0)
  SetStarFieldSpeedMin(StarFieldA, 0)
  
  For Index = 0 To #STARFIELD_STAR_MAX - 1
    SetStarFieldSpeed(StarFieldA, Index, 0)
    SetStarFieldPosX(StarFieldA, Index, 0)
    SetStarFieldPosY(StarFieldA, Index, 0)
    SetStarFieldPosZ(StarFieldA, Index, 0)
  Next
  
EndMacro

Macro RefreshStar3D(StarFieldA, Index)
  
  SetStarFieldSpeed(StarFieldA, Index, GetStarFieldSpeedMin(StarFieldA) + Random(Int(GetStarFieldSpeedMin(StarFieldA)))/10)
  SetStarFieldPosX(StarFieldA, Index, Random(3000) - 1500)
  SetStarFieldPosY(StarFieldA, Index, Random(3000) - 1500)
  SetStarFieldPosZ(StarFieldA, Index, 100 + Random(900))
  
EndMacro

Procedure InitializeStarField(*StarFieldA.StarField, P_ScreenWidth.w, P_ScreenHeight.w, P_SpeedMin.f = 4.75)
  
  SetStarFieldScreenWidth(*StarFieldA, P_ScreenWidth)
  SetStarFieldScreenHeight(*StarFieldA, P_ScreenHeight)
  SetStarFieldSpeedMin(*StarFieldA, P_SpeedMin)
  
  For Index = 0 To #STARFIELD_STAR_MAX - 1
    RefreshStar3D(*StarFieldA, Index)
  Next
  
EndProcedure

Procedure DisplayStarField(*StarFieldA.StarField)
  
  If StartDrawing(ScreenOutput())
      
      DrawingMode(1)
      
      For Index = 0 To #STARFIELD_STAR_MAX - 1
        
        GetStarFieldPosZ(*StarFieldA, Index) - GetStarFieldSpeed(*StarFieldA, Index)
        
        SX = GetStarFieldPosX(*StarFieldA, Index) / GetStarFieldPosZ(*StarFieldA, Index) * 100 + GetStarFieldScreenWidth(*StarFieldA) / 2
        SY = GetStarFieldPosY(*StarFieldA, Index) / GetStarFieldPosZ(*StarFieldA, Index) * 100 + GetStarFieldScreenHeight(*StarFieldA) / 2
        
        If SX < 0 Or SY < 0 Or SX >= GetStarFieldScreenWidth(*StarFieldA) Or SY >= GetStarFieldScreenHeight(*StarFieldA) Or GetStarFieldPosZ(*StarFieldA, Index) < 1 
          RefreshStar3D(*StarFieldA, Index)
        Else 
          Couleur = Int(255 - GetStarFieldPosZ(*StarFieldA, Index) * (255/1000))
          Plot(SX, SY, RGB(Couleur, Couleur, Couleur)) 
        EndIf
        
      Next
      
    StopDrawing()
    
  EndIf
  
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Déclaration de la Structure <<<<<

Structure Ball
  
  SpriteID.l
  PosX.f
  PosY.f
  
EndStructure

Macro GetBallSpriteID(BallA)
  
  BallA\SpriteID
  
EndMacro

Macro GetBallPosX(BallA)
  
  BallA\PosX
  
EndMacro

Macro GetBallPosY(BallA)
  
  BallA\PosY
  
EndMacro

Macro SetBallSpriteID(BallA, P_SpriteID)
  
  GetBallSpriteID(BallA) = P_SpriteID
  
EndMacro

Macro SetBallPosX(BallA, P_PosX)
  
  GetBallPosX(BallA) = P_PosX
  
EndMacro

Macro SetBallPosY(BallA, P_PosY)
  
  GetBallPosY(BallA) = P_PosY
  
EndMacro

Macro UpdateBall(BallA, P_SpriteID, P_PosX, P_PosY)
  
  SetBallSpriteID(BallA, P_SpriteID)
  SetBallPosX(BallA, P_PosX)
  SetBallPosY(BallA, P_PosY)
  
EndMacro

Macro ResetBall(BallA)
  
  If IsSprite(GetBallSpriteID(BallA)) <> 0
    FreeSprite(GetBallSpriteID(BallA))
  EndIf 
  
  SetBallSpriteID(BallA, 0)
  SetBallPosX(BallA, 0)
  SetBallPosY(BallA, 0)
  
EndMacro

Macro UpdateBallPosition(BallA, P_PosX, P_PosY)
  
  SetBallPosX(BallA, P_PosX)
  SetBallPosY(BallA, P_PosY)
  
EndMacro

Macro MoveBallPosition(BallA, BallB, P_Speed)
  
  SetBallPosX(BallA, GetBallPosX(BallA) + (GetBallPosX(BallB) - GetBallPosX(BallA)) * P_Speed)
  SetBallPosY(BallA, GetBallPosY(BallA) + (GetBallPosY(BallB) - GetBallPosY(BallA)) * P_Speed)
  
EndMacro

Macro DisplayBall(BallA)
  
  DisplayTransparentSprite(GetBallSpriteID(BallA), GetBallPosX(BallA), GetBallPosY(BallA))
  
EndMacro

Procedure InitializeBall(*BallA.Ball, P_BallColor.l, P_BallDiameter.l)
  
  SetBallSpriteID(*BallA, CreateSprite(#PB_Any, P_BallDiameter, P_BallDiameter))
  BallRadius.l = P_BallDiameter >> 1
  
  If GetBallSpriteID(*BallA)
    If StartDrawing(SpriteOutput(GetBallSpriteID(*BallA)))
        Circle(BallRadius, BallRadius, BallRadius, P_BallColor)
      StopDrawing()
    EndIf
  EndIf
  
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Déclaration de la Structure <<<<<

Structure Snake
  
  ScreenWidth.w
  ScreenHeight.w
  HeadSpeed.f
  HeadAngle.f
  HeadPosX.f
  HeadPosY.f
  HeadMoveX.f
  HeadMoveY.f
  HeadRotation.f
  Distance.f
  Speed.f
  Angle.f
  ProximityCounter.l
  BallsColor.l
  BallsDiameter.w
  BallsRadius.w
  BallsMax.w
  Balls.Ball[#SNAKE_BALLS_MAX]
  
EndStructure

Macro GetSnakeScreenWidth(SnakeA)
  
  SnakeA\ScreenWidth
  
EndMacro

Macro GetSnakeScreenHeight(SnakeA)
  
  SnakeA\ScreenHeight
  
EndMacro

Macro GetSnakeHeadSpeed(SnakeA)
  
  SnakeA\HeadSpeed
  
EndMacro

Macro GetSnakeHeadAngle(SnakeA)
  
  SnakeA\HeadAngle
  
EndMacro

Macro GetSnakeHeadPosX(SnakeA)
  
  SnakeA\HeadPosX
  
EndMacro

Macro GetSnakeHeadPosY(SnakeA)
  
  SnakeA\HeadPosY
  
EndMacro

Macro GetSnakeHeadMoveX(SnakeA)
  
  SnakeA\HeadMoveX
  
EndMacro

Macro GetSnakeHeadMoveY(SnakeA)
  
  SnakeA\HeadMoveY
  
EndMacro

Macro GetSnakeHeadRotation(SnakeA)
  
  SnakeA\HeadRotation
  
EndMacro

Macro GetSnakeDistance(SnakeA)
  
  SnakeA\Distance
  
EndMacro

Macro GetSnakeSpeed(SnakeA)
  
  SnakeA\Speed
  
EndMacro

Macro GetSnakeAngle(SnakeA)
  
  SnakeA\Angle
  
EndMacro

Macro GetSnakeProximityCounter(SnakeA)
  
  SnakeA\ProximityCounter
  
EndMacro

Macro GetSnakeBallsColor(SnakeA)
  
  SnakeA\BallsColor
  
EndMacro

Macro GetSnakeBallsDiameter(SnakeA)
  
  SnakeA\BallsDiameter
  
EndMacro

Macro GetSnakeBallsRadius(SnakeA)
  
  SnakeA\BallsRadius
  
EndMacro

Macro GetSnakeBallsMax(SnakeA)
  
  SnakeA\BallsMax
  
EndMacro

Macro GetSnakeBalls(SnakeA, Index)
  
  SnakeA\Balls[Index]
  
EndMacro

Macro SetSnakeScreenWidth(SnakeA, P_ScreenWidth)
  
  GetSnakeScreenWidth(SnakeA) = P_ScreenWidth
  
EndMacro

Macro SetSnakeScreenHeight(SnakeA, P_ScreenHeight)
  
  GetSnakeScreenHeight(SnakeA) = P_ScreenHeight
  
EndMacro

Macro SetSnakeHeadSpeed(SnakeA, P_HeadSpeed)
  
  GetSnakeHeadSpeed(SnakeA) = P_HeadSpeed
  
EndMacro

Macro SetSnakeHeadAngle(SnakeA, P_HeadAngle)
  
  GetSnakeHeadAngle(SnakeA) = P_HeadAngle
  
EndMacro

Macro SetSnakeHeadPosX(SnakeA, P_HeadPosX)
  
  GetSnakeHeadPosX(SnakeA) = P_HeadPosX
  
EndMacro

Macro SetSnakeHeadPosY(SnakeA, P_HeadPosY)
  
  GetSnakeHeadPosY(SnakeA) = P_HeadPosY
  
EndMacro

Macro SetSnakeHeadMoveX(SnakeA, P_HeadMoveX)
  
  GetSnakeHeadMoveX(SnakeA) = P_HeadMoveX
  
EndMacro

Macro SetSnakeHeadMoveY(SnakeA, P_HeadMoveY)
  
  GetSnakeHeadMoveY(SnakeA) = P_HeadMoveY
  
EndMacro

Macro SetSnakeHeadRotation(SnakeA, P_HeadRotation)
  
  GetSnakeHeadRotation(SnakeA) = P_HeadRotation
  
EndMacro

Macro SetSnakeDistance(SnakeA, P_Distance)
  
  GetSnakeDistance(SnakeA) = P_Distance
  
EndMacro

Macro SetSnakeSpeed(SnakeA, P_Speed)
  
  GetSnakeSpeed(SnakeA) = P_Speed
  
EndMacro

Macro SetSnakeAngle(SnakeA, P_Angle)
  
  GetSnakeAngle(SnakeA) = P_Angle
  
EndMacro

Macro SetSnakeProximityCounter(SnakeA, P_ProximityCounter)
  
  GetSnakeProximityCounter(SnakeA) = P_ProximityCounter
  
EndMacro

Macro SetSnakeBallsColor(SnakeA, P_BallsColor)
  
  GetSnakeBallsColor(SnakeA) = P_BallsColor
  
EndMacro

Macro SetSnakeBallsDiameter(SnakeA, P_BallsDiameter)
  
  GetSnakeBallsDiameter(SnakeA) = P_BallsDiameter
  
EndMacro

Macro SetSnakeBallsRadius(SnakeA, P_BallsRadius)
  
  GetSnakeBallsRadius(SnakeA) = P_BallsRadius
  
EndMacro

Macro SetSnakeBallsMax(SnakeA, P_BallsMax)
  
  GetSnakeBallsMax(SnakeA) = P_BallsMax
  
EndMacro

Macro SetSnakeBalls(SnakeA, Index, P_Balls)
  
  CopyBall(P_Balls, GetSnakeBalls(SnakeA, Index))
  
EndMacro

Macro ResetSnake(SnakeA)
  
  SetSnakeScreenWidth(SnakeA, 0)
  SetSnakeScreenHeight(SnakeA, 0)
  SetSnakeHeadSpeed(SnakeA, 0)
  SetSnakeHeadAngle(SnakeA, 0)
  SetSnakeHeadPosX(SnakeA, 0)
  SetSnakeHeadPosY(SnakeA, 0)
  SetSnakeHeadMoveX(SnakeA, 0)
  SetSnakeHeadMoveY(SnakeA, 0)
  SetSnakeHeadRotation(SnakeA, 0)
  SetSnakeDistance(SnakeA, 0)
  SetSnakeSpeed(SnakeA, 0)
  SetSnakeAngle(SnakeA, 0)
  SetSnakeProximityCounter(SnakeA, 0)
  SetSnakeBallsColor(SnakeA, 0)
  SetSnakeBallsDiameter(SnakeA, 0)
  SetSnakeBallsRadius(SnakeA, 0)
  SetSnakeBallsMax(SnakeA, 0)
  
  For Index = 0 To #SNAKE_BALLS_MAX - 1
    ResetBall(GetSnakeBalls(SnakeA, Index))
  Next
  
EndMacro

Procedure InitializeSnake(*SnakeA.Snake, P_ScreenWidth.w, P_ScreenHeight.w, P_BallsColor.l, P_BallsDiameter.l = 32, P_BallsMax.w = #SNAKE_BALLS_MAX)
  
  SetSnakeScreenWidth(*SnakeA, P_ScreenWidth)
  SetSnakeScreenHeight(*SnakeA, P_ScreenHeight)
  SetSnakeHeadSpeed(*SnakeA, 10)
  SetSnakeHeadAngle(*SnakeA, 0)
  SetSnakeHeadPosX(*SnakeA, 0)
  SetSnakeHeadPosY(*SnakeA, 0)
  SetSnakeHeadMoveX(*SnakeA, 0)
  SetSnakeHeadMoveY(*SnakeA, 0)
  SetSnakeHeadRotation(*SnakeA, 2 * #PI / 120)
  SetSnakeDistance(*SnakeA, 0)
  SetSnakeSpeed(*SnakeA, 0.20)
  SetSnakeProximityCounter(*SnakeA, 0)
  SetSnakeBallsColor(*SnakeA, P_BallsColor)
  SetSnakeBallsDiameter(*SnakeA, P_BallsDiameter)
  SetSnakeBallsRadius(*SnakeA, P_BallsDiameter >> 1)
  
  If P_BallsMax > #SNAKE_BALLS_MAX
    P_BallsMax = #SNAKE_BALLS_MAX
  EndIf
  
  SetSnakeBallsMax(*SnakeA, P_BallsMax)
  
  For Index = 0 To GetSnakeBallsMax(*SnakeA) - 1
    InitializeBall(GetSnakeBalls(*SnakeA, Index), GetSnakeBallsColor(*SnakeA), GetSnakeBallsDiameter(*SnakeA))
  Next
  
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< L'opérateur Display <<<<<

Procedure DisplaySnake(*SnakeA.Snake)
  
  ; Position de la première boule que l'on calcule
  ; Il s'agit de la boule 0
  
  If GetSnakeDistance(*SnakeA) < GetSnakeHeadSpeed(*SnakeA) ; Si on est arrivé, on va vers un autre point en aléatoire
    SetSnakeHeadMoveX(*SnakeA, Random(GetSnakeScreenWidth(*SnakeA)))
    SetSnakeHeadMoveY(*SnakeA, Random(GetSnakeScreenHeight(*SnakeA)))
  EndIf
  
  If GetSnakeDistance(*SnakeA) < GetSnakeHeadSpeed(*SnakeA) * 40 ; Si on arrive pas à atteindre le point au bout d'un moment, on dis qu'on l'a eu
    
    SetSnakeProximityCounter(*SnakeA, GetSnakeProximityCounter(*SnakeA) + 1)
    
    If GetSnakeProximityCounter(*SnakeA) > 200
      SetSnakeHeadMoveX(*SnakeA, Random(GetSnakeScreenWidth(*SnakeA)))
      SetSnakeHeadMoveY(*SnakeA, Random(GetSnakeScreenHeight(*SnakeA)))
    EndIf
    
  Else
    
    SetSnakeProximityCounter(*SnakeA, 0)
    
  EndIf
  
  ; Distance entre la boule et le point visé
  
  SetSnakeDistance(*SnakeA, Sqr((GetSnakeHeadMoveX(*SnakeA) - GetSnakeHeadPosX(*SnakeA)) * (GetSnakeHeadMoveX(*SnakeA) - GetSnakeHeadPosX(*SnakeA)) + (GetSnakeHeadMoveY(*SnakeA) - GetSnakeHeadPosY(*SnakeA)) * (GetSnakeHeadMoveY(*SnakeA) - GetSnakeHeadPosY(*SnakeA))))
  
  ; Angle entre la boule et le point visé
  
  If GetSnakeHeadMoveX(*SnakeA) >= GetSnakeHeadPosX(*SnakeA) And GetSnakeHeadMoveY(*SnakeA) >= GetSnakeHeadPosY(*SnakeA) ; entre 0 et Pi/2
    SetSnakeAngle(*SnakeA, ACos((GetSnakeHeadMoveX(*SnakeA) - GetSnakeHeadPosX(*SnakeA)) / GetSnakeDistance(*SnakeA)))
  ElseIf GetSnakeHeadMoveX(*SnakeA) >= GetSnakeHeadPosX(*SnakeA) And GetSnakeHeadMoveY(*SnakeA) <= GetSnakeHeadPosY(*SnakeA) ; entre 0 et -Pi/2
    SetSnakeAngle(*SnakeA, -ACos((GetSnakeHeadMoveX(*SnakeA) - GetSnakeHeadPosX(*SnakeA)) / GetSnakeDistance(*SnakeA)))
  ElseIf GetSnakeHeadMoveX(*SnakeA) <= GetSnakeHeadPosX(*SnakeA) And GetSnakeHeadMoveY(*SnakeA) >= GetSnakeHeadPosY(*SnakeA) ; entre Pi/2 et Pi
    SetSnakeAngle(*SnakeA, #PI - ACos((GetSnakeHeadPosX(*SnakeA) - GetSnakeHeadMoveX(*SnakeA)) / GetSnakeDistance(*SnakeA)))
  Else ; entre -Pi/2 et -Pi
    SetSnakeAngle(*SnakeA, -#PI + ACos((GetSnakeHeadPosX(*SnakeA) - GetSnakeHeadMoveX(*SnakeA)) / GetSnakeDistance(*SnakeA)))
  EndIf
  
  ; Si l'angle est plus grand que #Pi ou plus petit que -#Pi, on le ramene est -#pi et #pi
  
  If GetSnakeHeadAngle(*SnakeA) > #PI
    SetSnakeHeadAngle(*SnakeA, GetSnakeHeadAngle(*SnakeA) - 2 * #PI)
  EndIf
  
  If GetSnakeHeadAngle(*SnakeA) < -#PI
    SetSnakeHeadAngle(*SnakeA, GetSnakeHeadAngle(*SnakeA) + 2 * #PI)
  EndIf
  
  ; on regarde dans quel sens on doit faire évoluer l'angle
  
  If GetSnakeHeadAngle(*SnakeA) >= GetSnakeAngle(*SnakeA)
    If GetSnakeHeadAngle(*SnakeA) - GetSnakeAngle(*SnakeA) > #PI
      SetSnakeHeadAngle(*SnakeA, GetSnakeHeadAngle(*SnakeA) + GetSnakeHeadRotation(*SnakeA))
    Else
      SetSnakeHeadAngle(*SnakeA, GetSnakeHeadAngle(*SnakeA) - GetSnakeHeadRotation(*SnakeA))
    EndIf
  Else
    If GetSnakeAngle(*SnakeA) - GetSnakeHeadAngle(*SnakeA) > #PI
      SetSnakeHeadAngle(*SnakeA, GetSnakeHeadAngle(*SnakeA) - GetSnakeHeadRotation(*SnakeA))
    Else
      SetSnakeHeadAngle(*SnakeA, GetSnakeHeadAngle(*SnakeA) + GetSnakeHeadRotation(*SnakeA))
    EndIf
  EndIf
  
  ; On déplace suivant l'angle
  
  SetSnakeHeadPosX(*SnakeA, (GetSnakeHeadPosX(*SnakeA) + Cos(GetSnakeHeadAngle(*SnakeA)) * GetSnakeHeadSpeed(*SnakeA)))
  SetSnakeHeadPosY(*SnakeA, (GetSnakeHeadPosY(*SnakeA) + Sin(GetSnakeHeadAngle(*SnakeA)) * GetSnakeHeadSpeed(*SnakeA)))
  
  UpdateBallPosition(GetSnakeBalls(*SnakeA, 00), GetSnakeHeadPosX(*SnakeA) - GetSnakeBallsRadius(*SnakeA), GetSnakeHeadPosY(*SnakeA) - GetSnakeBallsRadius(*SnakeA))
  
  For n = (GetSnakeBallsMax(*SnakeA) - 1) To 1 Step -1 ; Pour chaque boule
    
    MoveBallPosition(GetSnakeBalls(*SnakeA, n), GetSnakeBalls(*SnakeA, n - 1), GetSnakeSpeed(*SnakeA))
    DisplayBall(GetSnakeBalls(*SnakeA, n))
    
  Next
  
  DisplayBall(GetSnakeBalls(*SnakeA, 00))
  
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< DÉBUT DU PROGRAMME <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

If InitSprite() <> 0 And InitKeyboard() <> 0 And InitMouse() <> 0
  
  ExamineDesktops()
  ScreenW = DesktopWidth(0)
  ScreenH = DesktopHeight(0)
  
  If OpenScreen(ScreenW, ScreenH, 32, "Snake Balls")
    
    ; SetFrameRate(55)
    
    ; Initialisation des paramètres, génération des sprites, ...
    InitializeStarField(StarField.StarField, ScreenW, ScreenH)
    InitializeSnake(Snake00.Snake, ScreenW, ScreenH, RGB(000, 255, 000))
    InitializeSnake(Snake01.Snake, ScreenW, ScreenH, RGB(255, 000, 000), 32, 75)
    InitializeSnake(Snake02.Snake, ScreenW, ScreenH, RGB(000, 000, 255), 32, 50)
    InitializeSnake(Snake03.Snake, ScreenW, ScreenH, RGB(255, 255, 000), 32, 55)
    InitializeSnake(Snake04.Snake, ScreenW, ScreenH, RGB(128, 000, 255), 32, 25)
    InitializeSnake(Snake05.Snake, ScreenW, ScreenH, RGB(255, 128, 000), 24, 45)
    
    Repeat
      
      ExamineMouse()
      ExamineKeyboard()
      
      ClearScreen(0) ; On efface l'écran
      
      ; On affiche les éléments de l'animation 2D
      
      DisplayStarField(StarField)
      DisplaySnake(Snake00)
      DisplaySnake(Snake01)
      DisplaySnake(Snake02)
      DisplaySnake(Snake03)
      DisplaySnake(Snake04)
      DisplaySnake(Snake05)
      
      FlipBuffers()
      
    Until KeyboardPushed(#PB_Key_Escape)
    
    ; Libération des Sprites, remise à zéro des paramètres, ...
    ResetStarField(StarField)
    ResetSnake(Snake00)
    ResetSnake(Snake01)
    ResetSnake(Snake02)
    ResetSnake(Snake03)
    ResetSnake(Snake04)
    ResetSnake(Snake05)
    
    CloseScreen()
    
  EndIf
  
EndIf

; <<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< FIN DU FICHIER <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<

Super vos boules ....enfin celles dans le code

Merci à tout les deux un vrai feu d'artifice

Juste une remarque sur le code de guimauve, j'ai un serpent tout droit rouge dans l'IDE sur la ligne 715 quand je fais escape

Code : Tout sélectionner

ResetSnake(Snake01)

Encore bravo et merci du partage

Kwai chang caine a écrit :Super vos boules ....enfin celles dans le code
Merci à tout les deux un vrai feu d'artifice

Juste une remarque sur le code de guimauve, j'ai un serpent tout droit rouge dans l'IDE sur la ligne 715 quand je fais escape
Code : Tout sélectionner
ResetSnake(Snake01)
Encore bravo et merci du partage

C'est drôle je n'ai pas de message d'erreur avec jaPBe....

Le problème provenait de la macro ResetBall(), j'ai ajouter une vérification à savoir si le Sprite est valide avant de le détruire. J'ai fait des tests et je n'ai plus de message d'erreur.

A+
Guimauve

J'en ai plus non plus.
Maintenant j'ai changé de machine, j'suis sur XP, alors qu'avant j'etais sur 2000.
J'sais pas si ça a de l'importance

Je testerais ça peut etre lundi.
Enfin c'etait juste pour info, parce que moi, mes codes y font que des lignes rouges....
D'ailleur passé un temps, je croyais que c'etait le pointeur de l'IDE qui s'arretait a chaque ligne pour montrer ou il en etait

Encore bravo

PureBasic

Serpent de boule

Serpent de boule

Re: Serpent de boule

Re: Serpent de boule

Re: Serpent de boule

Re: Serpent de boule