PureBasic

Code : Tout sélectionner

#pi=3.141593
#pipi=2*#pi

Procedure.f wraptour(tr.f)
 tr-Int(tr)
 If tr<0
   ProcedureReturn tr+1
  Else
   ProcedureReturn tr
 EndIf
EndProcedure

Procedure.f anglentour(x.f,y.f)
 dist.f=Sqr(x*x+y*y)
 If ASin(-x/dist)<0
   ProcedureReturn wraptour(-ACos(y/dist)/#pipi)
  Else
   ProcedureReturn wraptour(ACos(y/dist)/#pipi)
 EndIf
EndProcedure


Procedure.l bobface(x1,y1,x2,y2,x3,y3,x4,y4)
 xa=x1: ya=y1: xb=x2: yb=y2: xc=x4: yc=y4
 For t=1 To 2
   If wraptour(anglentour(xc-xa,yc-ya)-anglentour(xb-xa,yb-ya))>0.5
     renvoi | 2
    Else
     renvoi | 1
   EndIf
   xa=x2: ya=y2: xb=x3: yb=y3
 Next
 ProcedureReturn renvoi
EndProcedure



scx=getsystemmetrics_(#sm_cxscreen)
scy=getsystemmetrics_(#sm_cyscreen)



;vous pouvez remplacer ça par un LoadImage
imid=CreateImage(0,scx,scy)
bitblt_(StartDrawing(ImageOutput()),0,0,scx,scy,getdc_(getdesktopwindow_()),0,0,#srccopy)
StopDrawing()

hwin=OpenWindow(0,0,0,scx,scy,#pb_window_borderless,"")
StartDrawing(WindowOutput())
 DrawImage(imid,0,0)
StopDrawing()

If scx<>400 Or scy<>300
  ResizeImage(0,400,300)
EndIf

InitSprite() : InitSprite3D()
OpenWindowedScreen(hwin,0,0,scx,scy,0,0,0)

For x=0 To 49 : For y=0 To 36
 imid=GrabImage(0,1,x<<3,y<<3,8,8)
 numsprite=x+y*50
 CreateSprite(numsprite,8,8,#pb_sprite_texture)
 StartDrawing(SpriteOutput(numsprite))
  DrawImage(imid,0,0)
 StopDrawing()
 CreateSprite3D(numsprite,numsprite)
 ;CopySprite(numsprite,numsprite+10001)
 If WindowEvent()=#wm_keyup
   HideWindow(0,1) : End
 EndIf
Next:Next

FreeImage(0) : FreeImage(1)

For numsprite=10000 To 10000+49+36*50
 CreateSprite(numsprite,8,8,#pb_sprite_texture)
 UseBuffer(numsprite)
 For x=0 To 7
  ClipSprite(numsprite-10000,x,0,1,8)
  DisplaySprite(numsprite-10000,7-x,0)
 Next
 If WindowEvent()=#wm_keyup
   HideWindow(0,1) : End
 EndIf
 CreateSprite3D(numsprite,numsprite)
Next

;FreeSprite(17500)
UseBuffer(-1)


Structure noeud
  x.f : y.f
EndStructure



Dim grille.noeud(50,37)
For x=0 To 50 : For y=0 To 37
  grille(x,y)\x=(scx*x)/25
  grille(x,y)\y=(scy*y)/18.5
Next:Next

DefType.noeud souris,visee
vitesse.f=0.02
basepondero.f=Sqr(Pow(scx,2)+Pow(scy,2))*20
InitMouse()
SetFrameRate(0)

Repeat
 
 
 pondero=basepondero*vitesse+1
 souris\x=MouseX() : souris\y=MouseY()
 
 For x=0 To 50 : For y=0 To 37
   
   poids.f=Sqr(Pow(souris\x-(scx*x)/50,2)+Pow(souris\y-(scy*y)/37,2))/pondero
   xv.f=(scx*x)/50 : yv.f=(scy*y)/37
   visee\x=(xv*poids+souris\x*(1-poids))*(1-poids)+xv*poids
   visee\y=(yv*poids+souris\y*(1-poids))*(1-poids)+yv*poids
   
   ;Décommentez pour un effet "froissé" (pas très au point)
   
;    Repeat
;      If visee\x<0
;        visee\x=-visee\x
;       ElseIf visee\x>scx
;        visee\x/scx
;        visee\x=(visee\x-Int(visee\x))*scx
;       Else
;        Break
;      EndIf
;    ForEver
;    Repeat
;      If visee\y<0
;        visee\y=-visee\y
;       ElseIf visee\y>scy
;        visee\y/scy
;        visee\y=(visee\y-Int(visee\y))*scy
;       Else
;        Break
;      EndIf
;    ForEver

   grille(x,y)\x+((visee\x-grille(x,y)\x)*vitesse)
   grille(x,y)\y+((visee\y-grille(x,y)\y)*vitesse)
   
 Next:Next
 
 Start3D() : For x=0 To 49 : For y=0 To 36
   
   numsprite=x+y*50
   DefType.noeud c1,c2,c3,c4
   CopyMemory(@grille(x,y),@c1,SizeOf(noeud))
   CopyMemory(@grille(x+1,y),@c2,SizeOf(noeud))
   CopyMemory(@grille(x+1,y+1),@c3,SizeOf(noeud))
   CopyMemory(@grille(x,y+1),@c4,SizeOf(noeud));:CallDebugger
   visibilite=bobface(c1\x,c1\y,c2\x,c2\y,c3\x,c3\y,c4\x,c4\y)
   If visibilite & 1
     TransformSprite3D(numsprite,c1\x,c1\y,c2\x,c2\y,c3\x,c3\y,c4\x,c4\y)
     DisplaySprite3D(numsprite,0,0,128)
   EndIf
   If visibilite & 2
     numsprite+10000
     TransformSprite3D(numsprite,c2\x,c2\y,c1\x,c1\y,c4\x,c4\y,c3\x,c3\y)
     DisplaySprite3D(numsprite,0,0,128)
   EndIf
   
 Next:Next:Stop3D()
 
 ExamineMouse()
 vitesse+(MouseWheel()*0.001)
 If vitesse<=0 : vitesse=0.001 :EndIf
 FlipBuffers() : ClearScreen(127,127,127) 
Until WindowEvent()=#wm_keyup
ReleaseMouse(1)
HideWindow(0,1)