mini jeu - puzzle (compatible PB/SB)
Publié : sam. 01/oct./2016 8:45
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
