PureBasic

Forums PureBasic
Nous sommes le Sam 24/Aoû/2019 10:11

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 8 messages ] 
Auteur Message
 Sujet du message: mini jeu - puzzle (compatible PB/SB)
MessagePosté: Sam 01/Oct/2016 8:45 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 25/Juin/2015 16:18
Messages: 262
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:
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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: mini jeu - puzzle (compatible PB/SB)
MessagePosté: Sam 01/Oct/2016 11:26 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 09/Oct/2005 16:51
Messages: 8739
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 :. Tour + portable W10 x64 PB 5.4x / 5.6x
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
RESIZER GOLD : Mon logiciel de redimensionnement par lot 100% PB


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: mini jeu - puzzle (compatible PB/SB)
MessagePosté: Lun 03/Oct/2016 12:15 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 23/Sep/2006 18:32
Messages: 6644
Localisation: Isere
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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: mini jeu - puzzle (compatible PB/SB)
MessagePosté: Mar 04/Oct/2016 19:06 
Hors ligne

Inscription: Mer 21/Jan/2004 17:48
Messages: 5162
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.


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: mini jeu - puzzle (compatible PB/SB)
MessagePosté: Lun 17/Oct/2016 15:40 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 25/Juin/2015 16:18
Messages: 262
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)


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: mini jeu - puzzle (compatible PB/SB)
MessagePosté: Lun 17/Oct/2016 18:26 
Hors ligne

Inscription: Mer 21/Jan/2004 17:48
Messages: 5162
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.


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: mini jeu - puzzle (compatible PB/SB)
MessagePosté: Mar 18/Oct/2016 9:05 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 25/Juin/2015 16:18
Messages: 262
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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: mini jeu - puzzle (compatible PB/SB)
MessagePosté: Mar 18/Oct/2016 21:28 
Hors ligne

Inscription: Mer 21/Jan/2004 17:48
Messages: 5162
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/viewtopic.php?f=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.


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 8 messages ] 

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 2 invités


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  
cron

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye