cgaSerpent (inspiré de Nibble de Rick Raddatz)

Sujets variés concernant le développement en PureBasic
Ollivier
Messages : 4197
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

cgaSerpent (inspiré de Nibble de Rick Raddatz)

Message par Ollivier »

Allez hop ! Qui, sans perdre ses yeux, va dépasser mon record ?!?
(362 points)

Code : Tout sélectionner

Structure main
    w.d
    h.d
    xM.d
    yM.d
EndStructure
Define *this.main = AllocateMemory(SizeOf(main) )

recomp = 1
With *this
    InitSprite()
    InitKeyboard()
    InitMouse()
    ExamineDesktops()
    \w = DesktopWidth(0)
    \h = DesktopHeight(0)
    \xM = \w - 1
    \yM = \h - 1
    OpenScreen(\w, \h, 32, "")
    Dim s(1)
    s(0) = CreateSprite(#PB_Any, 80, 50, #PB_Sprite_AlphaBlending)
    StartDrawing(SpriteOutput(s(0) ) )
    DrawingMode(#PB_2DDrawing_AllChannels)
    Box(0, 0, 80, 50, RGBA(255, 0, 0, 255) )
    Box(1, 1, 78, 48, RGBA(0, 0, 255, 255) )    
    Plot(40, 25, RGBA(255, 255, 255, 255) )
    StopDrawing()
    Define.d x0, y0, x1, y1, x2, y2, x3, y3
    Define.d xMin, yMin, xMax, yMax
    xMin = 0.0
    yMin = 0.0
    xMax = 1.0
    yMax = 1.0
    x0 = xMin
    y0 = yMin
    x1 = xMax
    y1 = yMin
    x2 = xMax
    y2 = yMax
    x3 = xMin
    y3 = yMax
    mode | 1
    dir = 0
    x = 39
    y = 25
    wt = 200
    Dim x(3999)
    Dim y(3999)
    x(avant) = 39
    y(avant) = 25
    foodX = 40
    foodY = 25    
    Dim kb(255)
    Dim k(5, 1)
    score =-1
    Repeat        
        Delay(16)
        ExamineKeyboard()
        ExamineMouse()
        ClearScreen(RGB(0, 0, 0) )
        If KeyboardReleased(#PB_Key_Space): mode ! 1: EndIf
        If mode
            For i = 0 To 5
                k(i, 1) = k(i, 0)
            Next         
            k(0, 0) = KeyboardPushed(#PB_Key_Up)
            k(1, 0) = KeyboardPushed(#PB_Key_Down)
            k(2, 0) = KeyboardPushed(#PB_Key_Left)
            k(3, 0) = KeyboardPushed(#PB_Key_Right)
            k(4, 0) = KeyboardPushed(#PB_Key_PageUp)
            k(5, 0) = KeyboardPushed(#PB_Key_PageDown)
            For i = 0 To 5
                If k(i, 0) And Not k(i, 1)
                    kb(kbi) = 1 << i
                    kbi + 1
                    kbi % 256
                    kbL + 1
                EndIf
            Next         
            clk = ElapsedMilliseconds()
            If clk => forward
                If kbL > 0
                    kbL - 1
                    kdir = kb(kbo)
                    kbo + 1
                    kbo % 256
                    If kdir & 1 And (dir & 4 = 0): dir = 4: EndIf    
                    If kdir & 2 And (dir & 4 = 0): dir = 12: EndIf    
                    If kdir & 4 And (dir & 4 = 4): dir = 8: EndIf    
                    If kdir & 8 And (dir & 4 = 4): dir = 0: EndIf
                    If kdir & 16: dir + 4: dir & 15: EndIf
                    If kdir & 32: dir - 4: dir & 15: EndIf
                EndIf
                forward = clk + wt
                Select dir
                    Case 0: x + 1
                    Case 4: y - 1
                    Case 8: x - 1
                    Case 12: y + 1
                EndSelect
                avant + 1
                avant % 4000
                x(avant) = x
                y(avant) = y                
                StartDrawing(SpriteOutput(s(0) ) )
                c = Point(x, y) 
                If c <> RGB(0, 0, 255)
                    If c <> RGB(255, 255, 255)
                        mode = 0
                    Else
                        level + 1
                        allonge + recomp
                        If level < 64
                            If (level & %11) = 0
                                recomp + 1
                            EndIf
                        Else
                            recomp = 2
                        EndIf
                        score + recomp
                        If level >= 3                            
                            appears + 16
                            If appears > 255
                                appears = 255
                            EndIf
                        EndIf
                        If wt > 70
                            wt - 1
                        EndIf
                        Repeat
                            foodX = Random(79)
                            foodY = Random(49)
                        Until Point(foodX, foodY) = RGB(0, 0, 255)
                        Plot(foodX, foodY, RGB(255, 255, 255) )
                    EndIf
                EndIf
                If allonge
                    allonge - 1
                Else
                    Plot(x(arriere), y(arriere), RGB(0, 0, 255) )               
                    arriere + 1
                    arriere % 4000
                EndIf
                Plot(x, y, RGB(255, 255, 0) )
                Plot(x, y, RGB(255, 255, 0) )
                StopDrawing()
                s(1) = CopySprite(s(0), #PB_Any, #PB_Sprite_AlphaBlending)
            EndIf
            TransformSprite(s(0), x0 * \xM, y0 * \yM, x1 * \xM, y1 * \yM, x2 * \xM, y2 * \yM, x3 * \xM, y3 * \yM)
            TransformSprite(s(1), x0 * \xM, y0 * \yM, x1 * \xM, y1 * \yM, x2 * \xM, y2 * \yM, x3 * \xM, y3 * \yM)
            SpriteQuality(0)
            DisplayTransparentSprite(s(0), 0, 0, 255 - appears)
            SpriteQuality(#PB_Sprite_BilinearFiltering)
            DisplayTransparentSprite(s(1), 0, 0, appears)
        EndIf
        StartDrawing(ScreenOutput() )            
        DrawingMode(#PB_2DDrawing_Transparent)
        DrawText(0, 0, "SCORE : " + Str(score), RGB(255, 255, 255) )
        StopDrawing()
        FlipBuffers()
    Until KeyboardPushed(#PB_Key_Escape) Or MouseButton(#PB_MouseButton_Right)
EndWith
Avatar de l’utilisateur
Ar-S
Messages : 9539
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: cgaSerpent (inspiré de Nibble de Rick Raddatz)

Message par Ar-S »

Merci pour le partage.
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Avatar de l’utilisateur
SPH
Messages : 4937
Inscription : mer. 09/nov./2005 9:53

Re: cgaSerpent (inspiré de Nibble de Rick Raddatz)

Message par SPH »

Ca me fait penser a "Super Snake" sur MSX

Il est hors de question que j'essaye de te battre. Je trouve ce jeu gonflant 🙄

!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.12LTS- 64 bits
Avatar de l’utilisateur
falsam
Messages : 7317
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: cgaSerpent (inspiré de Nibble de Rick Raddatz)

Message par falsam »

SPH a écrit : ven. 10/mars/2023 12:06 Il est hors de question que j'essaye de te battre. Je trouve ce jeu gonflant
Essaye Crazy Snake (100% purebasic) ca va te détendre :lol:
:arrow: https://falsam.com/download/purebasic/CrazySnake.zip (Source et assets)
Configuration : Windows 11 Famille 64-bit - PB 6.20 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Ollivier
Messages : 4197
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: cgaSerpent (inspiré de Nibble de Rick Raddatz)

Message par Ollivier »

D'accord mais combien de points vous avez fait ?
Avatar de l’utilisateur
case
Messages : 1545
Inscription : lun. 10/sept./2007 11:13

Re: cgaSerpent (inspiré de Nibble de Rick Raddatz)

Message par case »

542 mais j'ai les yeux qui saignent :)
ImageImage
nemerod
Messages : 40
Inscription : mer. 24/août/2022 0:58

Re: cgaSerpent (inspiré de Nibble de Rick Raddatz)

Message par nemerod »

Va faire une version en faux 3D avec tous les effect fais a la main avec que les fonction 2D drawing ONLY
ne pas utilisé de openscreen ou encore moins des sprite :)
c'est pas chatGTP qui serais capable de faire se type de chose XD
n'a pas étais testé avec les version suivant a la 5.21 LTS x64

c'est un vieux code fais le 1 avril 2017 dans la nuit

si vous n'arrivé pas a comprendre mon code c'est normal meme moi j'ai du mal vue qu'il est trop vieux

Code : Tout sélectionner

;code removed by User 1178
Dernière modification par nemerod le ven. 10/mars/2023 23:48, modifié 1 fois.
Avatar de l’utilisateur
falsam
Messages : 7317
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: cgaSerpent (inspiré de Nibble de Rick Raddatz)

Message par falsam »

Joli ce code. Merci pour ce partage coloré.
Configuration : Windows 11 Famille 64-bit - PB 6.20 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
case
Messages : 1545
Inscription : lun. 10/sept./2007 11:13

Re: cgaSerpent (inspiré de Nibble de Rick Raddatz)

Message par case »

joli mais ouille tout petit et très mouvant ^^
bravo en tout cas
ImageImage
Ollivier
Messages : 4197
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: cgaSerpent (inspiré de Nibble de Rick Raddatz)

Message par Ollivier »

@case

542 points ? Mais tu m'aurais pas niqué ?

@nemerod

qu'est-ce que c'est que cette oeuvre Dart ? Bon ben dès que j'ai le temps de rallumer un PC, je teste ton code.

Merci, par avance, au cas où ton attente soit impossible.
Tu n'as toujours pas dit pourquoi tu étais sans sprite ni openscreen (taille finale de l'exécutable ?).

Ce qui m'ennuie avec le canvas c'est que ça bouffe de la ressource par pixel. À la limite, ImageGadget() est ptêt moins gourmand.

En tout cas, je regarde volontiers dès que possible. Et encore merci. Ce type de retour, à la force d'un code nu de documents images et sons externe, c'est très moche MAIS ça prouve un don de soi aux autres. Donc même si tu déviais de mon sujet initial, c'est bien pour ça que j'ai choisi la section Discussion générale :

encore un grand merci !

Aveuglément, je te recopie ce code d'Octobre 2022 de ma source, pour faire du son (mono 44KHz 16bits) au cas où :

Code : Tout sélectionner

structure wav
 array w.w(21)
endStructure
initSound()
*wav.wav = allocateMemory(sizeOf(wav) )
initializeStructure(*wav, wav)
base64decoder("UklGRgAAAABXQVZFZm10IBAAAAABAAEARKwAAIhYAQACABAAZGF0YQ", @*wav\w(0), 40)
with *wav
 wMax = 62800
 reDim \w(wMax + 22)
 size = (wMax + 23) * 2
 PokeL(@\w(2), size - 8)
 PokeL(@\w(20), size - 44)
 ampli.d = 800
 for i = 0 to wMax
  \w(i + 22) = cos(i / (7 - sin(t.d) ) ) * ampli
  ampli * 0.999
  t + 0.00015
 next
 snd = catchSound(#pb_any, @\w(0) )
 repeat
  playSound(snd, #pb_sound_multiChannel)
  delay(400)
 until inputRequester("", "Just press enter to play", "")
endWith
Ollivier
Messages : 4197
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: cgaSerpent (inspiré de Nibble de Rick Raddatz)

Message par Ollivier »

Bonjour nemerod,

il y a ton oeuvre d'art qui s'est vaporisée, pourrais-tu la remettre s'il-te-plaît ?

Et comme il n'y avait pas de son (wav) dedans, est-ce que mon 2ème code ci-dessus avec son en-tête base 64 complètement laide est quand même efficace et "limpide comme une goutte d'eau" ?
nemerod
Messages : 40
Inscription : mer. 24/août/2022 0:58

Re: cgaSerpent (inspiré de Nibble de Rick Raddatz)

Message par nemerod »

Ollivier a écrit : sam. 11/mars/2023 9:49 Bonjour nemerod,

il y a ton oeuvre d'art qui s'est vaporisée, pourrais-tu la remettre s'il-te-plaît ?

Et comme il n'y avait pas de son (wav) dedans, est-ce que mon 2ème code ci-dessus avec son en-tête base 64 complètement laide est quand même efficace et "limpide comme une goutte d'eau" ?
impossible, si je te donne la raison le tous serais hors sujet avec le topic de base
Ollivier
Messages : 4197
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: cgaSerpent (inspiré de Nibble de Rick Raddatz)

Message par Ollivier »

nemerod a écrit : sam. 11/mars/2023 18:49
Ollivier a écrit : sam. 11/mars/2023 9:49 Bonjour nemerod,

il y a ton oeuvre d'art qui s'est vaporisée, pourrais-tu la remettre s'il-te-plaît ?

Et comme il n'y avait pas de son (wav) dedans, est-ce que mon 2ème code ci-dessus avec son en-tête base 64 complètement laide est quand même efficace et "limpide comme une goutte d'eau" ?
impossible, si je te donne la raison le tous serais hors sujet avec le topic de base
mytho !

En réalité, c'est le score de case qui t'a fait flipper !
Ollivier
Messages : 4197
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: cgaSerpent (inspiré de Nibble de Rick Raddatz)

Message par Ollivier »

@case

584 points !
Avatar de l’utilisateur
case
Messages : 1545
Inscription : lun. 10/sept./2007 11:13

Re: cgaSerpent (inspiré de Nibble de Rick Raddatz)

Message par case »

bravo :)
ImageImage
Répondre