un cercle

[comtois]

Code : Tout sélectionner

;Comtois 03/12/04
;Cercle par l'algorithme de Bresenham 

;-Declare
Declare Erreur(Message$)

;-Initialisation 
#ScreenWidth = 800 : #ScreenHeight = 600 : #ScreenDepth = 32 
If InitEngine3D() = 0 
  Erreur("Impossible d'initialiser la 3D , vérifiez la présence de engine3D.dll") 
ElseIf InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse()=0
  Erreur("Impossible d'initialiser DirectX 7 Ou plus") 
ElseIf OpenScreen( #ScreenWidth , #ScreenHeight , #ScreenDepth , "" ) = 0 
  Erreur("Impossible d'ouvrir l'écran ") 
EndIf

;-Procedures
Procedure Erreur(Message$)
  MessageRequester( "Erreur" , Message$ , 0 ) 
  End 
EndProcedure
Procedure cercle(x,y,R,c) 
  ;Attention il n"y a pas de contrôle de débordement 
  xx = 0 
  yy = R 
  d = 1 - R 
  Plot(x+xx,y+yy,c)
  Plot(x-xx,y+yy,c) 
  Plot(x+xx,y-yy,c) 
  Plot(x-xx,y-yy,c) 
  Plot(x+yy,y+xx,c) 
  Plot(x-yy,y+xx,c) 
  Plot(x+yy,y-xx,c) 
  Plot(x-yy,y-xx,c) 
  While  yy > xx 
    If  d < 0 
      d + (2 * xx + 3) 
    Else 
      d + (2 * (xx - yy) + 5) 
      yy - 1 
    EndIf  
      xx + 1
    Plot(x+yy,y+xx,c) 
    Plot(x-yy,y+xx,c) 
    Plot(x+yy,y-xx,c) 
    Plot(x-yy,y-xx,c) 
    Plot(x+xx,y+yy,c) 
    Plot(x+xx,y-yy,c) 
    Plot(x-xx,y+yy,c) 
    Plot(x-xx,y-yy,c) 
 Wend   
EndProcedure
;- Boucle principale 
rayon=50
Repeat 
  ClearScreen(0,0,0)
  ExamineKeyboard()
  ExamineMouse()
  If MouseButton(1) And rayon<#ScreenHeight
  rayon+1
  EndIf
  If MouseButton(2) And rayon>2
  rayon-1
  EndIf
  StartDrawing(ScreenOutput())
  cercle(MouseX(),MouseY(),rayon,RGB(255,255,5))  
  ;validez ces deux lignes pour comparer avec le cercle de pure
  ;DrawingMode(4)
  ;Circle(MouseX(),MouseY(),rayon,RGB(5,255,255))   
  StopDrawing()
  FlipBuffers() 
Until KeyboardPushed(#PB_Key_Escape)

eh oui , tout ça pour un cercle , mais j'ai une bonne excuse ,il pleut dehors , et j'ai pas mieux à faire

[nico]

ça finit par planter!

[Backup]

................

[comtois]

ça finit par plantél

oui mais j'avais prévenu

Procedure cercle(x,y,R,c)
;Attention il n"y a pas de contrôle de débordement

Dobro , l'intérêt de cette méthode c'est qu'elle n'utilise que des entiers , pas de cos , ni de sin .

[filperj]

On peut remplacer plot(x,y,c) par box(x,y,1,1,c) pour éviter le plantage

[comtois]

On peut remplacer plot(x,y,c) par box(x,y,1,1,c) pour éviter le plantage

bien vu

Par contre ,j'ai testé et ça ralenti considérablement la fonction.
sans les box ,j'obtiens à peu près le même temps que la commande circle de purebasic, mais avec les box c'est 40 fois plus lent .

en faisant un simple contrôle , il n'y a plus de plantage et ça reste assez rapide, mais il faudrait l'adapter au contexte graphique .

bref faudrait essayer en écrivant en mémoire directement , sans passer par des plots .

faut surtout penser à cette fonction quand on a besoin de faire un cercle avec autre chose que des points , je pense à des tiles pour faire une map , ou dans un jeu pour calculer la position d'objets disposés en cercle.
le calcul est plus rapide qu'avec des cos et des sin , ça peut être intéressant .

Code : Tout sélectionner

Procedure Plot2(x,y,c)
If x>=0 And x<#ScreenWidth And y>=0 And y<#ScreenHeight
  Plot(x,y,c)
EndIf
EndProcedure
Procedure cercle(x,y,R,c) 
  xx = 0 
  yy = R 
  d = 1 - R 
  Plot2(x+xx,y+yy,c) 
  Plot2(x-xx,y+yy,c) 
  Plot2(x+xx,y-yy,c) 
  Plot2(x-xx,y-yy,c) 
  Plot2(x+yy,y+xx,c) 
  Plot2(x-yy,y+xx,c) 
  Plot2(x+yy,y-xx,c) 
  Plot2(x-yy,y-xx,c) 
  While  yy > xx 
    If  d < 0 
      d + (2 * xx + 3) 
    Else 
      d + (2 * (xx - yy) + 5) 
      yy - 1 
    EndIf  
      xx + 1 
    Plot2(x+yy,y+xx,c) 
    Plot2(x-yy,y+xx,c) 
    Plot2(x+yy,y-xx,c) 
    Plot2(x-yy,y-xx,c) 
    Plot2(x+xx,y+yy,c) 
    Plot2(x+xx,y-yy,c) 
    Plot2(x-xx,y+yy,c) 
    Plot2(x-xx,y-yy,c) 
 Wend    
EndProcedure