Code: Select all
;Comtois
;Version PureBasic le 18/02/2005
;Version SpiderBasic le 09/04/2015
Structure NewPoint
x.l
y.l
dx.l
dy.l
EndStructure
Declare Erreur(Message$)
Declare TracePolygone()
Declare AffPoints()
Declare TestPoint(x1, Y1, X2, Y2, d)
Declare PolygoneConvexe()
Declare Repartition()
Global ScreenHeight, ScreenWidth, ScreenDepth
If ExamineDesktops()
ScreenWidth = DesktopWidth(0)/2
ScreenHeight = DesktopHeight(0)/2
ScreenDepth = DesktopDepth(0)
Else
Erreur("Euh ?")
EndIf
#Nbpoints = 18
#Taille = 16
Global NewList ListPoint.NewPoint()
Global NewList Polygone.NewPoint()
DiametreSelection=6
OpenWindow(0,0,0,ScreenWidth,ScreenHeight,"Polygone")
OpenWindowedScreen(WindowID(0), 0,0,ScreenWidth,ScreenHeight)
Procedure RenderFrame()
Static x, y, x2, y2, Paused, previousElapsed
ClearScreen(0)
ExamineKeyboard()
AffPoints()
PolygoneConvexe()
TracePolygone()
ForEach ListPoint()
DisplayTransparentSprite(0,ListPoint()\x - #Taille, ListPoint()\y - #Taille)
Next
FlipBuffers() ; continue the rendering
EndProcedure
FlipBuffers() ; start the rendering
BindEvent(#PB_Event_RenderFrame, @RenderFrame())
Repartition()
CreateSprite(0,#Taille * 2, #Taille * 2)
StartDrawing(SpriteOutput(0))
For i = 0 To #Taille
Circle(#Taille, #Taille,#Taille - i, RGB(20 + i * 6, 40 + i * 6, 40 + i * 6))
Next
StopDrawing()
CreateSprite(1,1,1)
StartDrawing(SpriteOutput(1))
Box(0,0,1,1, RGB(255,255,0))
StopDrawing()
;-Procedures
Procedure Erreur(Message$)
;MessageRequester("Erreur", Message$, 0)
Debug Message$
EndProcedure
Procedure Repartition()
;Répartition des boules sur l'écran
For i=1 To #Nbpoints
AddElement(ListPoint())
*MemPos.NewPoint = ListPoint()
MemIndex=ListIndex(ListPoint())
Repeat
Collision = #False
x = #Taille + Random(ScreenWidth - #Taille * 2)
y = #Taille + Random(ScreenHeight - #Taille * 2)
If ListSize(ListPoint()) > 1
ForEach ListPoint()
If ListIndex(ListPoint()) = MemIndex
Continue
EndIf
If Sqr(Pow(ListPoint()\x - x, 2.0) + Pow(ListPoint()\y - y, 2.0)) <= #Taille * 2
Collision = #True
Break
EndIf
Next
EndIf
Until Collision = #False
SelectElement(ListPoint(), MemIndex)
ListPoint()\x = x
ListPoint()\y = y
ListPoint()\dx = 2 + Random(2)
ListPoint()\dy = 2 + Random(2)
Next
EndProcedure
Procedure PolygoneConvexe()
If ListSize(ListPoint()) < 2
ProcedureReturn #False
EndIf
;Initialise
*Min.NewPoint = #Null
*p0.NewPoint = #Null
*pi.NewPoint = #Null
*pc.NewPoint = #Null
;Trouve le point le plus bas dans la liste des points
FirstElement(ListPoint())
*Min = ListPoint()
ForEach ListPoint()
*p0 = ListPoint()
;Mémorise le point le plus bas , ou le plus à gauche s'il y a égalité
If (*p0\y < *Min\y) Or ((*p0\y = *Min\y) And (*p0\x < *Min\x))
*Min = *p0
EndIf
Next
;Initialise la liste pour le contour convexe
ClearList(Polygone())
;Effectue la progression de Jarvis pour calculer le contour
*p0 = *Min
Repeat
;Insertion du nouveau p0 dans le contour convexe
If AddElement(Polygone()) = 0
Erreur("plus de mémoire pour ajouter un élément dans polygone")
Else
Polygone()\x = *p0\x
Polygone()\y = *p0\y
EndIf
;Trouve le point pc dans le sens des aiguilles d'une montre
*pc = #Null
ForEach ListPoint()
*pi = ListPoint()
;Saute p0
If *pi = *p0
Continue
EndIf
;Sélectionne le premier point
If *pc = #Null
*pc = ListPoint()
Continue
EndIf
;Teste si pi est dans le sens des aiguilles d'une montre par rapport à pc
z=(((*pi\x - *p0\x) * (*pc\y - *p0\y)) - ((*pi\y - *p0\y) * (*pc\x - *p0\x)))
If z > 0
;pi est dans le sens des aiguilles d'une montre par rapport à pc
*pc = *pi
ElseIf z = 0
;Si pi et pc sont colinéaires , on choisit le plus éloigné de p0
longueurpi = Pow(*pi\x - *p0\x, 2.0) + Pow(*pi\y - *p0\y, 2.0)
longueurpc = Pow(*pc\x - *p0\x, 2.0) + Pow(*pc\y - *p0\y, 2.0)
If longueurpi > longueurpc
*pc = *pi
EndIf
EndIf
Next
;Cherche le point suivant
*p0 = *pc
Until *p0 = *Min
EndProcedure
Procedure DoLine(xi,yi,xf,yf)
x = xi
y = yi
dx = xf - xi
dy = yf - yi
If dx > 0
xinc = 1
Else
xinc = -1
EndIf
If dy > 0
yinc = 1
Else
yinc = -1
EndIf
dx = Abs(dx)
dy = Abs(dy)
DisplaySprite(1,x,y)
If dx > dy
cumul = dx / 2
For i = 1 To dx
x + xinc
cumul + dy
If (cumul >= dx)
cumul - dx
y + yinc
EndIf
DisplaySprite(1,x,y)
Next
Else
cumul = dy / 2
For i = 1 To dy
y + yinc
cumul + dx
If cumul >= dy
cumul - dy
x + xinc
EndIf
DisplaySprite(1,x,y)
Next
EndIf
EndProcedure
Procedure TracePolygone()
SelectElement(Polygone(), 0)
*mem0.NewPoint = Polygone()
*mem.NewPoint = Polygone()
While NextElement(Polygone())
DoLine(*mem\x, *mem\y, Polygone()\x, Polygone()\y)
*mem = Polygone()
Wend
DoLine(*mem0\x, *mem0\y, *mem\x, *mem\y)
EndProcedure
Procedure.l LimiteX(*Valeur.NewPoint, Min.l, Max.l)
If *Valeur\x < Min
*Valeur\x = Min
ProcedureReturn #True
ElseIf *Valeur\x > Max
*Valeur\x = Max
ProcedureReturn #True
EndIf
EndProcedure
Procedure AffPoints()
CouleurPoint = RGB(200, 255, 0)
Taille2 = #Taille / 2
ForEach ListPoint()
ListPoint()\x + ListPoint()\dx
ListPoint()\y + ListPoint()\dy
If ListPoint()\x< #Taille
ListPoint()\x = #Taille
ListPoint()\dx * -1
ElseIf ListPoint()\x > ScreenWidth - #Taille
ListPoint()\x = ScreenWidth - #Taille
ListPoint()\dx * -1
EndIf
If ListPoint()\y< #Taille
ListPoint()\y = #Taille
ListPoint()\dy * -1
ElseIf ListPoint()\y > ScreenHeight - #Taille
ListPoint()\y = ScreenHeight - #Taille
ListPoint()\dy * -1
EndIf
*MemPos.NewPoint=ListPoint()
MemIndex=ListIndex(ListPoint())
ForEach ListPoint()
If ListIndex(ListPoint()) = MemIndex
Continue
EndIf
;Calcul la distance
Distance = Sqr(Pow(ListPoint()\x - *MemPos\x, 2.0) + Pow(ListPoint()\y - *MemPos\y, 2.0))
If Distance <= #Taille * 2
*MemPos\dx * -1
*MemPos\dy * -1
*MemPos\x + *MemPos\dx
*MemPos\y + *MemPos\dy
EndIf
Next
SelectElement(ListPoint(), MemIndex)
Next
EndProcedure
Procedure TestPoint(x1, Y1, X2, Y2, d)
If x1 > X2 - d And x1 < X2 + d And Y1 > Y2 - d And Y1 < Y2 + d
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure