mini jeu - puzzle (compatible PB/SB)

Programmation avancée de jeux en PureBasic
Avatar de l’utilisateur
Guillot
Messages : 522
Inscription : jeu. 25/juin/2015 16:18

mini jeu - puzzle (compatible PB/SB)

Message par Guillot »

Image

Salut les codeurs,

encore un petit jeu compatible PB et SB
désolé pour les forme rectangulaire des pièces, j'avais fait des jolies pièces arrondies, mais ça fonctionne pas sous SB (manque les fonction 'clippath' ou 'vectorsourceimage' du PB)
peut être dans les prochaines version de SB

pour trouver de belles images je vous conseil:
https://pixabay.com/fr/photos/?q=ruisse ... in_height=

PS :vous pouvez régler le nombre de pièce ligne 20

Code : Tout sélectionner

EnableExplicit

Enumeration:#smouse:#schrono:#smessage:EndEnumeration

Structure spiece
    s.i
    i.w
    j.w
    x.w :y.w :a.w
    xo.w:yo.w:ao.w
    xb.w:yb.w:ab.w
    h.w
    b.w
    g.w
    d.w
    sel.b
EndStructure

ExamineDesktops()
Global nbpiecevoulu=50 ; <<<<<<<<<<<<
Global ex=DesktopWidth(0),ey=DesktopHeight(0),bidon,zoom.f=1,titre.s="Puzzle",fic.s
Global np,npj,lp,hp
Global Dim p.spiece(0) 
Global Dim zindex(0)


CompilerIf #PB_Compiler_OS<>5
  #SBCol=0
  Macro xUseJPEGImageDecoder:UseJPEGImageDecoder:EndMacro
  Macro xend:End:EndMacro
  Macro xClipPath(v):ClipPath(v):EndMacro
  Macro xReleaseMouse(v):ReleaseMouse(v):EndMacro
  Macro xMouseLocate(x,y):MouseLocate(x,y):EndMacro
  Macro xRenderFrame:Repeat:WindowEvent():RenderFrame(): ForEver:EndMacro
  Macro waitloadfinish:loadfinish():EndMacro
CompilerElse
  #SBCol=$ff000000
  Macro xUseJPEGImageDecoder():bidon=1:EndMacro
  Macro xend:ReleaseMouse(1):EndMacro
  Macro xClipPath(v):bidon=1:EndMacro
  Macro xReleaseMouse(v):bidon=1:EndMacro
  Macro xMouseLocate(x,y):bidon=1:EndMacro
  Macro xRenderFrame:BindEvent(#PB_Event_RenderFrame, @RenderFrame()):FlipBuffers():EndMacro
  Macro waitloadfinish:BindEvent(#PB_Event_Loading, @loadfinish()):EndMacro
CompilerEndIf

InitKeyboard()
InitMouse()
InitSprite()
xUseJPEGImageDecoder()

 Macro cola(col,a=$ff):((col|(a<<24))!#SBCol):EndMacro
 
 Macro limite(v,min,max):If v<min:v=min:EndIf:If v>max:v=max:EndIf:EndMacro

 Macro DrawingSprite(n,dx,dy)
     CreateSprite(n,dx,dy,#PB_Sprite_AlphaBlending)
     CreateImage(0,dx,dy,32,#PB_Image_Transparent)
     StartVectorDrawing(ImageVectorOutput(0))
 EndMacro
 
 Macro StopDrawingSprite(n)
     StopVectorDrawing()
     StartDrawing(SpriteOutput(n))
     DrawingMode(#PB_2DDrawing_AllChannels)
     DrawAlphaImage(ImageID(0),0,0)
     StopDrawing()
 EndMacro
 
Procedure init(n)   
    Protected   i,j,c,oix,oiy,ix,iy,x,y,px,py,ni,nj
    Protected.f r
    oix=ImageWidth(0)
    oiy=ImageHeight(0)
    r=oiy/oix
    ix=Sqr(ex*ey/(1.5*r)):iy=r*ix
    ResizeImage(0,ix,iy)
    ni=Sqr(n*ix/iy)
    nj=iy*ni/ix
    np=ni*nj
    lp=ix/ni
    hp=iy/nj
    Dim p(np)
    Dim zindex(np)
    c=0
    For j=0 To nj-1:y=j*hp
        For i=0 To ni-1:x=i*lp           
            GrabImage(0,1,x,y,lp,hp)
            CreateImage(2,lp,hp)
            StartVectorDrawing(ImageVectorOutput(2))
            DrawVectorImage(ImageID(1)):StrokePath(1); <-- bug SB : apres DrawVectorImage le tracé suivant ne s'affiche pas (d'où ce StrokePath bidon)
            Macro contour(dx,dy):MovePathCursor(dx,dy):AddPathLine(lp+1+dx,dy):AddPathLine(lp+1+dx,hp+1+dy):AddPathLine(dx,hp+1+dy):ClosePath():StrokePath(1):EndMacro
            VectorSourceColor(cola($000000,$44)):contour(-1.5,-1.5)
            VectorSourceColor(cola($ffffff,$44)):contour( 0.5, 0.5)
            StopVectorDrawing()
            c+1
            With p(c)
                \i=i
                \j=j
                \x=x+(ex-ix)/2:\xo=\x:\xb=Random(ex-lp)
                \y=y+(ey-iy)/2:\yo=\y:\yb=Random(ey-hp)
                \s=CreateSprite(-1,lp,hp,#PB_Sprite_AlphaBlending )
                StartDrawing(SpriteOutput(\s))
                DrawImage(ImageID(2),0,0)
                StopDrawing()
                zindex(c)=c
            EndWith
        Next
    Next
    RandomizeArray(zindex(),1,np)
    
    DrawingSprite(#smouse,32,32)
    AddPathSegments("M 0 0 L 32 16 L 16 32 Z")
    VectorSourceColor(cola($000000)):FillPath(#PB_Path_Preserve)
    VectorSourceColor(cola($ffffff)):StrokePath(2)
    StopDrawingSprite(#smouse)
       
    xMouseLocate(ex/2,ey/2)
EndProcedure

Procedure deplace(dx,dy)
    Protected k
    For k=1 To np
        If p(k)\sel:p(k)\x+dx:p(k)\y+dy:EndIf
    Next
EndProcedure

Procedure connexion()
    Protected k,l,x,y,dx,dy
    
    Macro prox(di,dj,cote1,cote2)
        dx=x-p(k)\x+di*lp
        dy=y-p(k)\y+dj*hp
        If (Abs(dx)<16 And Abs(dy)<16) And (p(l)\i+di=p(k)\i And p(l)\j+dj=p(k)\j)
            p(l)\cote1#=k
            p(k)\cote2#=l
            deplace(-dx,-dy)
            ProcedureReturn
        EndIf
    EndMacro
    
    For l=1 To np
        If p(l)\sel
            x=p(l)\x
            y=p(l)\y
            For k=1 To np
                If p(k)\sel=0
                    prox( 1,0,d,g)
                    prox(-1,0,g,d)
                    prox(0, 1,b,h)
                    prox(0,-1,h,b)
                EndIf
            Next
        EndIf
    Next
EndProcedure

Procedure piececonnexe(n)
    If n=0 Or p(n)\sel:ProcedureReturn:EndIf
    p(n)\sel=1
    npj+1
    piececonnexe(p(n)\h)
    piececonnexe(p(n)\b)
    piececonnexe(p(n)\g)
    piececonnexe(p(n)\d)
EndProcedure

Procedure selectionne(mx,my)
    Protected k,kk,l,i,dx,dy,psel=0,iz,pr
    For k=1 To np:i=zindex(k)
        dx=mx-p(i)\x
        dy=my-p(i)\y
        If dx>0 And dx<lp And dy>0 And dy<hp:psel=i:EndIf
    Next
    If psel:piececonnexe(psel):EndIf
    iz=np
    For k=0 To np:kk=zindex(k)
        If p(kk)\sel:For l=k To np-1:zindex(l)=zindex(l+1):Next:zindex(np)=kk:EndIf
    Next   
    ProcedureReturn psel
EndProcedure

Procedure message(txt1.s,txt2.s,txt3.s)
Macro dt(nf,y,t,col)
    DrawingFont(FontID(nf))
    DrawText((OutputWidth()-TextWidth(t))/2,y,t,col!#SBCol)
EndMacro
    CreateSprite(#smessage,600,200,#PB_Sprite_AlphaBlending)
    StartDrawing(SpriteOutput(#smessage))
    DrawingMode(#PB_2DDrawing_AllChannels)
    Box(0,0,600,200,cola(0,0))
    RoundBox(0,0,600,200,50,50,$88884444!#SBCol)
    DrawingMode(#PB_2DDrawing_AlphaBlend |#PB_2DDrawing_Transparent)
    dt(1,20,txt1,$ffffffff)
    dt(0,100,txt2,$ff00ffff)
    dt(0,150,txt3,$ff00ffff)
    StopDrawing()
EndProcedure
Procedure RenderFrame()
    Static n,etat=-1,amb,mb,amx,mx,amy,my,psel,chrono,chronoi
    Protected i,k,r.f,iz
    
    Macro effacesel:For k=0 To np:p(k)\sel=0:Next:EndMacro
    
    ExamineKeyboard()
    ExamineMouse()
    amb=mb:mb=MouseButton(1)
    amx=mx:mx=MouseX()
    amy=my:my=MouseY()
    ClearScreen($88aabb)
    Select etat
        Case -1
            message(titre,"Image: "+fic,Str(np)+" pieces"):etat=0
        Case 0
            If mb=1:n=0:etat=1:EndIf
        Case 1 ;========== brassage
            r=(1-Cos(Radian(n)))/2
            For i=0 To np
                With p(i)
                    \x=\xo*(1-r)+\xb*r
                    \y=\yo*(1-r)+\yb*r
                    \a=\ao*(1-r)+\ab*r
                EndWith
            Next
            n+4:If n>180:chronoi=Date():etat=2:EndIf
        Case 2 ;========== jeux
            chrono=Date()-chronoi
            If amb=0 And mb=1:psel=selectionne(mx,my):EndIf
            If amb=1 And mb=1 And psel:deplace(mx-amx,my-amy):EndIf
            If amb=1 And mb=0 :connexion():psel=0:effacesel:npj=0:piececonnexe(1)
                If npj=np:message("Bravo","Vous avez perdu "+Str(chrono/3600)+" heure(s) et "+ Str((chrono%3600)/60)+" minute(s)","Maintenant au boulot !"):etat=3:EndIf:effacesel
            EndIf
        Case 3
            If amb=0 And mb=1:xEnd:EndIf
    EndSelect   
    
    Macro affiche(msel,mombre)
        For i=1 To np:iz=zindex(i)
            If p(iz)\sel=msel
                ;RotateSprite(i,\a,0)
                If mombre=1:DisplayTransparentSprite(p(iz)\s, p(iz)\x+8,p(iz)\y+8 ,64,0!#SBCol):EndIf
                If mombre=0:DisplayTransparentSprite(p(iz)\s, p(iz)\x,p(iz)\y):EndIf
            EndIf
        Next 
    EndMacro
    affiche(0,0)
    affiche(1,1)
    affiche(1,0)
    
    DrawingSprite(#schrono,128,32)
    VectorSourceColor(cola($000000,$44)):FillVectorOutput()
    VectorSourceColor(cola($ffffff)):MovePathCursor(16,4):VectorFont(FontID(0), 25):DrawVectorText(FormatDate("%hh:%ii:%ss",chrono))
    StopDrawingSprite(#schrono)
    DisplayTransparentSprite(#schrono, 4,4)
    
    If etat=0 Or etat=3:DisplayTransparentSprite(#smessage,ex/2-300,ey/2-100):EndIf

    DisplayTransparentSprite(#smouse, mx,my)
    
    FlipBuffers()
    If KeyboardReleased(#PB_Key_Escape):xEnd:EndIf
EndProcedure

OpenWindow(0,0,0,ex* zoom,ey* zoom,"Puzzle",#PB_Window_BorderLess|#PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0),0,0,ex,ey,0,0,0,#PB_Screen_SmartSynchronization)
LoadFont(0, "arial", 20)
LoadFont(1, "arial", 50)

Procedure loadfinish()
    init(nbpiecevoulu)
    xRenderFrame
EndProcedure

CompilerIf #PB_Compiler_OS<>5 
  fic=OpenFileRequester("Selectionnez une image","","Fichier jpeg|*.jpeg;*.jpg",0)
  LoadImage(0,fic):waitloadfinish
CompilerElse
  Procedure lireimage()
    While NextSelectedFile():fic=SelectedFileName():Wend
    CloseWindow(1)
    LoadImage(0,fic,#PB_LocalFile):waitloadfinish
  EndProcedure 
  Procedure selection()
    OpenFileRequester("", @ lireimage(), #PB_Requester_MultiSelection)
  EndProcedure    
  OpenWindow(1, 0,0, 200, 140, "Puzzle",#PB_Window_ScreenCentered)
  ButtonGadget(0, 10, 10, 180, 120, "Selectionnez une image"):BindGadgetEvent(0, @ selection())
CompilerEndIf
Avatar de l’utilisateur
Ar-S
Messages : 9472
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: mini jeu - puzzle (compatible PB/SB)

Message par Ar-S »

Encore un très bon petit jeu en peu de lignes, bravo !
- Il faudrait accentuer un poil le magnétisme des pieces.
- Il faudrait avoir une touche pour revoir l'image originale.

Sinon c'est top ! :P
~~~~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
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: mini jeu - puzzle (compatible PB/SB)

Message par Kwai chang caine »

Ouaih super boulot !!! 8O
Merci aux gens comme toi de réaliser ce genre de codes qui permettent de sublimer notre super langage 8)
Et encore plus merci de le partager, et merci aussi pour le lien des belles images GRATUITES 8) 8)
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
comtois
Messages : 5172
Inscription : mer. 21/janv./2004 17:48
Contact :

Re: mini jeu - puzzle (compatible PB/SB)

Message par comtois »

Super comme tous les codes que tu proposes.
C'est toujours bien fini, beau et fonctionnel, BRAVO.

Par contre ça ne fonctionne pas avec la version démo de SB , une idée ? J'utilise la même image que pour mon test avec PB :
D:\PureBasic\5_50_x86\Examples\3D\Data\Textures\ValetCoeur.jpg
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.
Avatar de l’utilisateur
Guillot
Messages : 522
Inscription : jeu. 25/juin/2015 16:18

Re: mini jeu - puzzle (compatible PB/SB)

Message par Guillot »

salut,

merci pour vos retours
pas pu répondre plus tôt, en vacances
c'est un peu sommaire, mais je voulais le poster avant de partir

à comtois:
j'ai testé chez moi, sous Chrome (et Windows 7): pas de probleme
mais au boulot, sous Firefox (et Windows 10): marche pas (quelque soit l'image)
(note: j'ai juste mis le décodeur jpg)

à Ar-s:
pour augmenter le magnetisme: ligne 132 : remplace les 16 par une valeur plus elevée (c'est l'écart maximum)
comtois
Messages : 5172
Inscription : mer. 21/janv./2004 17:48
Contact :

Re: mini jeu - puzzle (compatible PB/SB)

Message par comtois »

Guillot a écrit :à comtois:
sous Firefox (et Windows 10): marche pas (quelque soit l'image)
C'est exactement ma config , je ne sais pas si Fred peut faire quelque chose, ça mérite peut-être un rapport de bug ?
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.
Avatar de l’utilisateur
Guillot
Messages : 522
Inscription : jeu. 25/juin/2015 16:18

Re: mini jeu - puzzle (compatible PB/SB)

Message par Guillot »

j'ai regardé de plus près
le problème se situ au niveau de VectorFont ou DrawVectorText
ligne 252
tu peux commenter la ligne (t'auras pas le chrono, c'est tout)
curieux, j'avais pas eu ce problème jusque ici
je vais essayer de trouver le contexte
comtois
Messages : 5172
Inscription : mer. 21/janv./2004 17:48
Contact :

Re: mini jeu - puzzle (compatible PB/SB)

Message par comtois »

Guillot a écrit :j'ai regardé de plus près
le problème se situ au niveau de VectorFont ou DrawVectorText ligne 252
tu peux commenter la ligne (t'auras pas le chrono, c'est tout)
Merci, ça fonctionne bien en commentant cette ligne.

Tu as vu le code de Freak ?
http://www.purebasic.fr/english/viewtop ... 13&t=66746

Il y a de quoi améliorer le puzzle :)
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.
Répondre