Polygon convex

Created a nice software using SpiderBasic ? Post you link here !
Comtois
Posts: 40
Joined: Mon Feb 24, 2014 11:07 pm

Polygon convex

Post by Comtois »

an old PureBasic's code adapted for SpiderBasic

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
User avatar
majikeyric
Posts: 7
Joined: Mon Feb 24, 2014 11:07 pm
Contact:

Re: Polygon convex

Post by majikeyric »

Nice Comtois !
Fred
Site Admin
Posts: 1506
Joined: Mon Feb 24, 2014 10:51 am

Re: Polygon convex

Post by Fred »

Looks good :)
zxretrosoft
Posts: 20
Joined: Sun Jan 25, 2015 10:37 am
Location: Prague, Czech Republic
Contact:

Re: Polygon convex

Post by zxretrosoft »

Very nice, Comtois! Thanks!;-)
Post Reply