N'oubliez pas de tourner la molette de la souris.
Ca tourne un peu mieux sans le débogueur.
C'est un peu long à démarrer, ya quelques 3700 spriteD à créer, des petits mais quand même...
(Au départ j'en avait mis 15 000, mais ma carte graphique a éclaté en sanglots ).
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)