J'ai commenté le source autant que possible, mais pour ceux que cela intéresse, un petit tour sur google ne sera pas du luxe pour une compréhension plus avancée.
Code : Tout sélectionner
EnableExplicit
Global.l i, j, k, l
Define.f val=48 ; isovaleur, c'est le seuil auquel on dessine une ligne
Define.l res=32 ; resolution: Le nombre de fois où on divise l'écran...
DataSection
; voici les 16 cas du marching square
; la première valeur correspond au nombre de lignes à tracer x2
; les paires de valeurs suivantes correspondent aux arrêtes à joindre par les lignes
datas:
Data.l 0 ; 0000 format DCBA (voir plus bas)
Data.l 2, 0,3 ; 0001
Data.l 2, 0,1 ; 0010
Data.l 2, 1,3 ; 0011
Data.l 2, 1,2 ; 0100
Data.l 4, 0,3, 1,2 ; 0101 par exemple ici nous traçons 2 lignes, qui joignent les arrêtes 0-3 et 1-2
Data.l 2, 0,2 ; 0110
Data.l 2, 2,3 ; 0111
Data.l 2, 2,3 ; 1000
Data.l 2, 0,2 ; 1001
Data.l 4, 2,3, 0,1 ; 1010
Data.l 2, 1,2 ; 1011
Data.l 2, 1,3 ; 1100
Data.l 2, 0,1 ; 1101
Data.l 2, 0,3 ; 1110
Data.l 0 ; 1111
; ces 4 positions correspondent au centre des 4 arrêtes AB (0) BC (1) CD (2) DA (3)
Data.f 0.5, 1 ; D--2--C Les 4 coins sont notés A B C D
Data.f 1, 0.5 ; 3-> | | Les 4 arrêtes numérotées de 0 à 3
Data.f 0.5, 0 ; | | <-1
Data.f 0, 0.5 ; A--0--B
EndDataSection
Procedure exit(text$)
If text$ : Debug (text$) : EndIf
End
EndProcedure
If Not(InitMouse() And InitKeyboard() And InitSprite())
exit("Can't init something")
EndIf
Define.l win=OpenWindow(#PB_Any, 0, 0, 1024, 1024, "", #PB_Window_ScreenCentered)
If Not(win) : exit("Can't open window") : EndIf
Define.l width=WindowWidth(win), height=WindowHeight(win)
Define.f stepx=width/res, stepy=height/res ; step x et step y = écran / résolution
If Not(OpenWindowedScreen(WindowID(win),0, 0, width, height))
exit("Can't open screen") : EndIf
Restore datas
Dim cnt(15)
Dim lines(15, 3)
For j=0 To 15
Read.l cnt(j)
For i=0 To cnt(j)-1
Read.l lines(j, i)
Next
Next
Dim posx.f(3) : Dim posy.f(3)
For i=0 To 3
Read.f posx(i)
Read.f posy(i)
Next
Dim lvl.f(res, res)
Global event
Define run=#True
Define.f t=0
While run
t+0.01
; on nettoie la grille
For j=0 To res
For i=0 To res
lvl(i, j)=0
Next
Next
; on place quelques metaball sur la grille
For k=0 To 5
Define.f ballx, bally, balld
ballx=(0.5+Cos(t+k*2.5)*0.5)*res ; position x de la metaball
bally=(0.5+Sin(t*1.5+k)*0.5)*res ; position y de la metaball
balld=res*res ; diametre de la metaball
For j=0 To res
For i=0 To res
lvl(i, j)+balld/(Pow(ballx-i,2)+Pow(bally-j, 2))
Next
Next
Next
ClearScreen(0)
StartDrawing(ScreenOutput())
; on dessine la grille dépendante de la résolution
For i=0 To res
LineXY(i*stepx, 0 ,i*stepx, height, $A00000)
LineXY(0, i*stepy, width, i*stepy, $A00000)
Next
; on trace les metaballs
For j=0 To res-1
For i=0 To res-1
; détermination du cas dans lequel on se trouve
Define cas.l = 0
If lvl(i+0, j+1) > val : cas+1 : EndIf ; coin A
If lvl(i+1, j+1) > val : cas+2 : EndIf ; coin B
If lvl(i+1, j+0) > val : cas+4 : EndIf ; coin C
If lvl(i+0, j+0) > val : cas+8 : EndIf ; coin D
; interpolation des arrêtes
; si vous êtes curieux vous pouvez commenter toute cette boucle "for k" jusqu'au prochain commentaire
; il est alors conseillé de monter fortement en résolution
For k=0 To cnt(cas)-1
Define.l side=lines(cas, k)
Define.f a, b
If side=0
a=lvl(i+0, j+1)
b=lvl(i+1, j+1)-a
posx(0)=(val-a)/b
EndIf
If side=2
a=lvl(i+0, j+0)
b=lvl(i+1, j+0)-a
posx(2)=(val-a)/b
EndIf
If side=1
a=lvl(i+1, j+0)
b=lvl(i+1, j+1)-a
posy(1)=(val-a)/b
EndIf
If side=3
a=lvl(i+0, j+0)
b=lvl(i+0, j+1)-a
posy(3)=(val-a)/b
EndIf
Next
; traçage des lignes
For k=0 To cnt(cas)-1 Step 2
Define.f xa, ya, xb, yb
xa=posx(lines(cas, k))
ya=posy(lines(cas, k))
xb=posx(lines(cas, k+1))
yb=posy(lines(cas, k+1))
LineXY((i+xa)*stepx, (j+ya)*stepy, (i+xb)*stepx, (j+yb)*stepy, $ffffff)
Next
Next
Next
StopDrawing()
FlipBuffers()
If ExamineKeyboard()
If KeyboardReleased(#PB_Key_Escape)
run=#False
EndIf
EndIf
Repeat
Event = WindowEvent()
Select Event
Case #PB_Event_CloseWindow
run=#False
EndSelect
Until Event=0
Wend
exit("")