J'arrivais pas à dormir....

Programmation avancée de jeux en PureBasic
Avatar de l’utilisateur
Chris
Messages : 3731
Inscription : sam. 24/janv./2004 14:54
Contact :

J'arrivais pas à dormir....

Message par Chris »

... alors je me suis amusé à faire ça!

C'est une espèce de jeu de squash, (mais avec un seul joueur), comme on en voyait sur les vielles consoles (type atari ou phillips) à la fin des années 70. Ca nous rajeunit pas !!! :lol:

C'est pas fini, et ça le sera probablement jamais, j'ai fait ça pour passer le temps. Il n'y a pas les scores, il n'y a qu'un joueur, (il en faudrait 2, pour bien faire), les balles sont illimitées, et il n'y a pas non plus les bruitages (plik...plok...plok)

Ca, c'était de l'ambiance :lol:

Et pour couronner le tout, il y a un bug, de temps en temps, quand la balle tape juste au bout de la raquette, elle la suit au lieu de rebondir, et c'est codé comme un goret.

Bref... Touches haut et bas pour la raquette, espace pour lancer la balle.

Code : Tout sélectionner

#Window = 0
#Width = 975      ; Les dimensions d'un terrain de squash
#Height = 640     ; enfin, d'après Internet...!
#Timer = 0

Enumeration
  #balle
  #Raquette
EndEnumeration

Global SensX, SensY

Procedure Sprites()
  If CreateSprite(#balle,24,24,0)           ; Sprite Balle
    StartDrawing(SpriteOutput(#balle))
    Circle(12,12,12,RGB($FF,$FF,$FF))
    StopDrawing()
  EndIf
  
  If CreateSprite(#Raquette,16,64,0)        ; Sprite Raquette
    StartDrawing(SpriteOutput(#Raquette))
    Box(0,0,16,64,RGB($FF,$FF,$FF))
    StopDrawing()
  EndIf
  
EndProcedure
  
Procedure TraceFond()
  StartDrawing(ScreenOutput())
  Box(544,0,5,640,RGB($FF,$FF,$FF))         ; Ligne de service
  
  Box(549,160,165,5,RGB($FF,$FF,$FF))       ; Carre de service haut
  Box(709,0,5,160,RGB($FF,$FF,$FF))
  
  Box(549,475,165,5,RGB($FF,$FF,$FF))       ; Carre de service bas
  Box(709,480,5,160,RGB($FF,$FF,$FF))
  
  Box(549,318,426,5,RGB($FF,$FF,$FF))
  StopDrawing()
EndProcedure

;- Initialisation de DirectX
If InitSprite() = 0 Or InitKeyboard() = 0
  MessageRequester("Erreur", "Impossible d'initialiser DirectX", 0)
  CloseWindow(#Window) : End
EndIf

;- Ouverture de la fenêtre et de l'écran
hwnd = OpenWindow(#Window, 0, 0, #Width, #Height, #PB_Window_TitleBar | #PB_Window_ScreenCentered, "PB-SQUASH")
OpenWindowedScreen(hwnd, 0, 0, #Width, #Height, 0, 0, 0)

Sprites()                   ; Affiche les sprites

X_Raquette = #Width - 30
Y_Raquette = #Height/2 - SpriteHeight(#Raquette)/2

Dep = Random(1)+1           ; Position de départ aléatoire

;- Début de la boucle

Repeat
  ClearScreen(0, 0, 0) : ExamineKeyboard()
  TraceFond() ; Trace la surface de jeu
  
  If x > X_Raquette Or x > #Width : Start = 0 ; La balle dépasse la raquette
    Dep = Random(1)+1                         ; Position de départ
  EndIf
  
  ; La balle tape sur le mur du fond.
  ; Si elle tape au milieu, il faut la dévier
  If x <= 0 : SensX = -SensX : EndIf
  
  ; La balle tape sur les murs de coté
  If y +24 >= #Height Or y <= 0 : SensY = -SensY : EndIf
  
  ;La balle touche la raquette
  If SpriteCollision(#balle,x,y,#Raquette,X_Raquette,Y_Raquette)
    ;Pour faire des lifts en haut ou en bas
    If KeyboardPushed(#PB_Key_Up)
      lift = -3
    ElseIf KeyboardPushed(#PB_Key_Down)
      lift = 3
    Else
      lift = 0
    EndIf
    SensY+lift 
    SensX = -SensX                  ; Renvoie la balle
    Coup + 1                        ; Ajoute 1 point
  EndIf
  
  ;SetWindowTitle(#Window, Str(Coup)); Pour contrôler le score, en attendant
  
  If Start = 1                      ; On joue, la balle se déplace
    x + SensX : y + SensY
  ElseIf Start = 0                  ; La balle est arrêtée
    If Dep = 1                      ; Point de départ en haut
      x = 620
      y = 70
    ElseIf Dep = 2                  ; Point de départ en bas
      x = 620
      y = 550
    EndIf
    
    SensX = 9 : SensX = -SensX      ; Inverse le sens pour que la balle parte à gauche
  EndIf
  
  ; Affiche la raquette et la balle
  DisplaySprite(#Raquette,X_Raquette, Y_Raquette)
  DisplayTransparentSprite(#balle,x,y)
  
  FlipBuffers()
  
  ; Raquette vers le haut
  If KeyboardPushed(#PB_Key_Up)
    If Y_Raquette > 0 : Y_Raquette - 10 : EndIf
  EndIf
  
  ;Raquette vers le bas
  If KeyboardPushed(#PB_Key_Down)
    If Y_Raquette + SpriteHeight(#Raquette) < #Height : Y_Raquette + 10 : EndIf
  EndIf
  
  ;Lance la balle
  If KeyboardReleased(#PB_Key_Space)
    SensY = Random(3)+ 2            ; Direction Y aléatoire
    If Dep = 2                      ; Si la balle part du bas
      SensY = -SensY                ; l'envoie vers le haut
    EndIf
    
    Start = 1                       ; Go !!!!
  EndIf
  
  If KeyboardPushed(#PB_Key_Escape) : quit = 1 : EndIf
  While WindowEvent() : Wend
Until quit = 1
Chris :)
Anonyme2
Messages : 3518
Inscription : jeu. 22/janv./2004 14:31
Localisation : Sourans

Message par Anonyme2 »

J'y ai beaucoup joué sur la télé en noir et blanc (819 lignes la première chaine)

Moi j'aime, tout simplement :wink:
Lukky
Messages : 340
Inscription : dim. 25/janv./2004 12:22
Localisation : Morbihan

Message par Lukky »

C'est bizarre, moi il m'occupe le proc à 100%.

JL
Quand on me gonfle trop j'éclate, sinon ça va !
Avatar de l’utilisateur
Chris
Messages : 3731
Inscription : sam. 24/janv./2004 14:54
Contact :

Message par Chris »

Lukky a écrit :C'est bizarre, moi il m'occupe le proc à 100%.

JL
Non, c'est pas bizarre!

Pourquoi tu crois que j'ai écrit que c'était codé comme un goret ?? :lol:

Tu peux tenter de l'optimiser si tu veux, j'ai pas l'intention de le continuer, de toute façon ;)

Chris :)
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

Message par comtois »

Chris a écrit :j'ai pas l'intention de le continuer, de toute façon ;)

Chris :)
Tu dis ça , mais tu n'es pas à l'abri d'une autre insomnie , et qu'est-ce que tu vas faire hein ? :lol:
Avatar de l’utilisateur
Chris
Messages : 3731
Inscription : sam. 24/janv./2004 14:54
Contact :

Message par Chris »

Je sais pas, un casse-brique, peut-être!

C'est pas un truc commun, ça, les casse-brique ! Personne ne l'a jamais fait ! :lol:

Plus sérieusement, c'est le genre de petit jeu tout bête qui pourrait permettre de mettre au point un truc en réseau! Pas de graphisme, rapide à coder, pas gourmand en ressources (sauf le mien, y bouffe tout, mais bon... )

Chris :)
Lukky
Messages : 340
Inscription : dim. 25/janv./2004 12:22
Localisation : Morbihan

Message par Lukky »

Je ne pense pas que l'on puisse programmer aussi mal !

Je vais d'abord chercher pour voir si j'ai pas un autre programme qui parasite tout ça avant de mettre en doute ta programmation, tu vois j'ai confiance !

JL
Quand on me gonfle trop j'éclate, sinon ça va !
Avatar de l’utilisateur
Chris
Messages : 3731
Inscription : sam. 24/janv./2004 14:54
Contact :

Message par Chris »

Je te rassure, chez moi, c'est pareil, il bouffe toutes les ressources qui passent à sa portée. Charge CPU = 100% :lol:

Chris :)
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

Message par comtois »

Chris a écrit :Plus sérieusement, c'est le genre de petit jeu tout bête qui pourrait permettre de mettre au point un truc en réseau! Pas de graphisme, rapide à coder, pas gourmand en ressources (sauf le mien, y bouffe tout, mais bon... )Chris :)
Oui , ça pourrait être intéressant de faire un truc en réseau , je mets l'idée de côté ,pour l'instant je suis à fond dans un éditeur 3D :)
mais si tu le fais , tu nous diras comment on se connecte peut te mettre la pâtée au squash ? :lol:
Avatar de l’utilisateur
Chris
Messages : 3731
Inscription : sam. 24/janv./2004 14:54
Contact :

Message par Chris »

Ah oui, pourquoi pas!

Mais je ne sais pas si tu as remarqué, mais y a qu'une raquette :lol:

Par contre, j'ai trouve ce qui bouffe les ressources, c'est la boucle. Faut que je trouves le moyen de faire ça mieux quand même

Chris :)
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

Message par comtois »

Mais je suis confiant ,tu vas trouver le budget pour ajouter une seconde raquette :)
Avatar de l’utilisateur
cederavic
Messages : 1338
Inscription : lun. 09/févr./2004 23:38
Localisation : Bordeaux

Message par cederavic »

rajoute delay(1) dans ta proc principale pour eviter de bouffer 100% cpu ;)
Avatar de l’utilisateur
Chris
Messages : 3731
Inscription : sam. 24/janv./2004 14:54
Contact :

Message par Chris »

cederavic a écrit :rajoute delay(1) dans ta proc principale pour eviter de bouffer 100% cpu ;)
Ouachhh!!! ... C'est magique !!!
Plus que 18 % de CPU au lieu de 100

Je vais mettre delay(1000000), y bouffera plus rien du tout :lol:

Merci :)

Chris :)
Avatar de l’utilisateur
Chris
Messages : 3731
Inscription : sam. 24/janv./2004 14:54
Contact :

Message par Chris »

Tiens, allez, j'ai rajouté les scores, et le nombre de balles. Et le chiffres sont dessinés "à l'ancienne", comme dirait Dobro. Comme sur les vielles consoles.

*** Ajouté***

J'ai rajouté les sons. On s'y croirait presque :P

Les sons sont là: A décompresser dans le même dossier que le code
http://www.cgsoftwares.com/PureBasic/PrgForum/bip.zip

Code : Tout sélectionner

 #Window = 0
#Width = 975      ; Les dimensions d'un terrain de squash
#Height = 640     ; enfin, d'après Internet...!

Enumeration
  #Uni = 1
  #Diz = 2
  #Cen = 3
  
  #balle
  #Raquette
  #NbreBalles
EndEnumeration

Enumeration
  #Fnt1
  #Fnt2
  #Son1
  #Son2
  #Son3
EndEnumeration

If InitSound()
Son1 = LoadSound(#Son1,"bip1.wav")
Son2 = LoadSound(#Son2,"bip2.wav")
Son3 = LoadSound(#Son3,"bip3.wav")
EndIf

Global SensX, SensY, Font1, Font2, TexteFin$, TexteFin2$ 

Declare AfficheScore(Sp)
Declare Points(Score.w)

Procedure Sprites()
  If CreateSprite(#balle,24,24,0)           ; Sprite Balle
    StartDrawing(SpriteOutput(#balle))
    Circle(12,12,12,RGB($FF,$FF,$FF))
    StopDrawing()
  EndIf
  
  If CreateSprite(#Raquette,16,64,0)        ; Sprite Raquette
    StartDrawing(SpriteOutput(#Raquette))
    Box(0,0,16,64,RGB($FF,$FF,$FF))
    StopDrawing()
  EndIf
  
  If CreateSprite(#NbreBalles,8,16)
    StartDrawing(SpriteOutput(#NbreBalles))
    Box(0,0,8,16,RGB($FF,$FF,$FF))
    StopDrawing()
  EndIf
  
  CreateSprite(#Uni,48,64)
  CreateSprite(#Diz,48,64)
  CreateSprite(#Cen,48,64)
EndProcedure
  
Procedure TraceFond()
  StartDrawing(ScreenOutput())
  Box(544,0,5,640,RGB($FF,$FF,$FF))         ; Ligne de service
  
  Box(549,160,165,5,RGB($FF,$FF,$FF))       ; Carre de service haut
  Box(709,0,5,160,RGB($FF,$FF,$FF))
  
  Box(549,475,165,5,RGB($FF,$FF,$FF))       ; Carre de service bas
  Box(709,480,5,160,RGB($FF,$FF,$FF))
  
  Box(549,318,426,5,RGB($FF,$FF,$FF))
  StopDrawing()
  
  DisplayTransparentSprite(#Uni,10,10)
  DisplayTransparentSprite(#Diz,65,10)
  DisplayTransparentSprite(#Cen,120,10)
EndProcedure
  
Procedure Points(Score.w)
  Score$ = Str(Score)
  l = Len(Score$)
  For i = 1 To l
    Spr$ = Mid(Score$,i,1)
    Select Spr$
      Case "1" : Restore Un
      Case "2" : Restore Deux
      Case "3" : Restore Trois
      Case "4" : Restore Quatre
      Case "5" : Restore Cinq
      Case "6" : Restore Six
      Case "7" : Restore Sept
      Case "8" : Restore Huit
      Case "9" : Restore Neuf
      Case "0" : Restore Zero
    EndSelect
    AfficheScore(i)
  Next
EndProcedure

Procedure AfficheScore(Sp)
  StartDrawing(SpriteOutput(Sp))
  For lig = 0 To 7
    For col = 0 To 5
      Read a.b
      If a = 1 : color = RGB(255,255,255) : EndIf
      If a = 0 : color = RGB(0,0,0) : EndIf
      Box(col*8, lig*8,8,8,color)
    Next
  Next
  StopDrawing()
EndProcedure

;- Initialisation de DirectX
If InitSprite() = 0 Or InitKeyboard() = 0
  MessageRequester("Erreur", "Impossible d'initialiser DirectX", 0)
  CloseWindow(#Window) : End
EndIf


;- Ouverture de la fenêtre et de l'écran
hwnd = OpenWindow(#Window, 0, 0, #Width, #Height, #PB_Window_TitleBar | #PB_Window_ScreenCentered, "PB-SQUASH")
OpenWindowedScreen(hwnd, 0, 0, #Width, #Height, 0, 0, 0)

Sprites()                                     ; Affiche les sprites
Points(0)

X_Raquette = #Width - 30
Y_Raquette = #Height/2 - SpriteHeight(#Raquette)/2

NbBall = 5
Dep = Random(1)+1                             ; Position de départ aléatoire

;- Début de la boucle

Repeat
  ClearScreen(0, 0, 0) : ExamineKeyboard()
  TraceFond()                                 ; Trace la surface de jeu
  
  For i = 1 To NbBall*(8+4) Step 12
    DisplaySprite(#NbreBalles, 10+i, 84)
  Next
  If NbBall = 0 : quit = 1 : EndIf
  
  If x > X_Raquette Or x > #Width : Start = 0 ; La balle dépasse la raquette
    PlaySound(#Son3,0)
    Dep = Random(1)+1 : NbBall -1             ; Position de départ
  EndIf
  
  ; La balle tape sur le mur du fond.
  If x <= 0 : SensX = -SensX
    PlaySound(#Son2,0)
  EndIf
  
  ; La balle tape sur les murs de coté
  
  If y +24 >= #Height Or y <= 0 : SensY = -SensY 
    PlaySound(#Son2,0)
  EndIf
  
  ;La balle touche la raquette
  If SpriteCollision(#balle,x,y,#Raquette,X_Raquette,Y_Raquette)
    SoundFrequency(#Son1, 9000) 
    PlaySound(#Son1,0)    ;Pour faire des lifts en haut ou en bas
    If KeyboardPushed(#PB_Key_Up)
      lift = -3
    ElseIf KeyboardPushed(#PB_Key_Down)
      lift = 3
    Else
      lift = 0
    EndIf
    SensY+lift 
    SensX = -SensX                  ; Renvoie la balle
    Coup +1 : Points(Coup)          ; Ajoute 1 point   
  EndIf
  
  If Start = 1                      ; On joue, la balle se déplace
    x + SensX : y + SensY
  ElseIf Start = 0                  ; La balle est arrêtée
    If Dep = 1                      ; Point de départ en haut
      x = 620
      y = 70
    ElseIf Dep = 2                  ; Point de départ en bas
      x = 620
      y = 550
    EndIf
    SensX = 9 : SensX = -SensX      ; Inverse le sens pour que la balle parte à gauche
  EndIf
  
  ; Affiche la raquette et la balle
  DisplaySprite(#Raquette,X_Raquette, Y_Raquette)
  DisplayTransparentSprite(#balle,x,y)
  
  FlipBuffers()
  
  ; Raquette vers le haut
  If KeyboardPushed(#PB_Key_Up)
    If Y_Raquette > 0 : Y_Raquette - 10 : EndIf
  EndIf
  
  ;Raquette vers le bas
  If KeyboardPushed(#PB_Key_Down)
    If Y_Raquette + SpriteHeight(#Raquette) < #Height : Y_Raquette + 10 : EndIf
  EndIf
  
  ;Lance la balle
  If Start = 0
    If KeyboardReleased(#PB_Key_Space)
      SensY = Random(3)+ 2            ; Direction Y aléatoire
      If Dep = 2                      ; Si la balle part du bas
        SensY = -SensY                ; l'envoie vers le haut
      EndIf
      
      Start = 1                       ; Go !!!!
    EndIf
  EndIf
  Delay(2)
  If KeyboardPushed(#PB_Key_Escape) : quit = 1 : EndIf
  While WindowEvent() : Wend
Until quit = 1
FreeSound(#Son1)
FreeSound(#Son2)
FreeSound(#Son3)
;{- Datas  
DataSection

Un:
Data.b 0,0,0,0,1,1
Data.b 0,0,0,0,0,1
Data.b 0,0,0,0,0,1
Data.b 0,0,0,0,0,1
Data.b 0,0,0,0,0,1
Data.b 0,0,0,0,0,1
Data.b 0,0,0,0,0,1
Data.b 0,0,0,0,0,1

Deux:
Data.b 1,1,1,1,1,1
Data.b 0,0,0,0,0,1
Data.b 0,0,0,0,0,1
Data.b 1,1,1,1,1,1
Data.b 1,0,0,0,0,0
Data.b 1,0,0,0,0,0
Data.b 1,0,0,0,0,0
Data.b 1,1,1,1,1,1

Trois:
Data.b 1,1,1,1,1,1
Data.b 0,0,0,0,0,1
Data.b 0,0,0,0,0,1
Data.b 1,1,1,1,1,1
Data.b 0,0,0,0,0,1
Data.b 0,0,0,0,0,1
Data.b 0,0,0,0,0,1
Data.b 1,1,1,1,1,1

Quatre:
Data.b 1,0,0,0,0,1
Data.b 1,0,0,0,0,1
Data.b 1,0,0,0,0,1
Data.b 1,1,1,1,1,1
Data.b 0,0,0,0,0,1
Data.b 0,0,0,0,0,1
Data.b 0,0,0,0,0,1
Data.b 0,0,0,0,0,1

Cinq:
Data.b 1,1,1,1,1,1
Data.b 1,0,0,0,0,0
Data.b 1,0,0,0,0,0
Data.b 1,1,1,1,1,1
Data.b 0,0,0,0,0,1
Data.b 0,0,0,0,0,1
Data.b 0,0,0,0,010
Data.b 1,1,1,1,1,1

Six:
Data.b 1,1,1,1,1,1
Data.b 1,0,0,0,0,0
Data.b 1,0,0,0,0,0
Data.b 1,1,1,1,1,1
Data.b 1,0,0,0,0,1
Data.b 1,0,0,0,0,1
Data.b 1,0,0,0,0,1
Data.b 1,1,1,1,1,1

Sept:
Data.b 1,1,1,1,1,1
Data.b 0,0,0,0,0,1
Data.b 0,0,0,0,0,1
Data.b 0,0,0,0,1,1
Data.b 0,0,0,0,0,1
Data.b 0,0,0,0,0,1
Data.b 0,0,0,0,0,1
Data.b 0,0,0,0,0,1

Huit:
Data.b 1,1,1,1,1,1
Data.b 1,0,0,0,0,1
Data.b 1,0,0,0,0,1
Data.b 1,1,1,1,1,1
Data.b 1,0,0,0,0,1
Data.b 1,0,0,0,0,1
Data.b 1,0,0,0,0,1
Data.b 1,1,1,1,1,1

Neuf:
Data.b 1,1,1,1,1,1
Data.b 1,0,0,0,0,1
Data.b 1,0,0,0,0,1
Data.b 1,1,1,1,1,1
Data.b 0,0,0,0,0,1
Data.b 0,0,0,0,0,1
Data.b 0,0,0,0,0,1
Data.b 1,1,1,1,1,1

Zero:
Data.b 1,1,1,1,1,1
Data.b 1,0,0,0,0,1
Data.b 1,0,0,0,0,1
Data.b 1,0,0,0,0,1
Data.b 1,0,0,0,0,1
Data.b 1,0,0,0,0,1
Data.b 1,0,0,0,0,1
Data.b 1,1,1,1,1,1

EndDataSection
;}
Chris :)
Dernière modification par Chris le mar. 08/juin/2004 18:37, modifié 2 fois.
Avatar de l’utilisateur
Chris
Messages : 3731
Inscription : sam. 24/janv./2004 14:54
Contact :

Message par Chris »

Quelqu'un saurait, ou je peut trouver des sons, histoire de sonoriser un peu le bestiau?

Il en faudrait trois ou quatre, dans le style des vieux jeux sur console.

Chris :)
Répondre