Dessiner sur un canvas

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Dessiner sur un canvas

Message par falsam »

■ Dessiner sur un canvas (ou une image) revient à faire un dessin souvent en pointillé comme le montre cette animation. Veuillez pardonner mon piètre talent de dessinateur. :mrgreen:

Image

Le code de base pour vous rendre compte par vous même.

Code : Tout sélectionner

Enumeration Window
  #MainForm
EndEnumeration

Enumeration Gadgets
  #Canvas
EndEnumeration

Global Draw

Declare EventDraw()

If OpenWindow(#MainForm, 0, 0, 1024, 768, "Canvas Draw", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  CanvasGadget(#Canvas, 0, 0, 1024, 768)
  BindGadgetEvent(#Canvas, @EventDraw())
  
  Repeat : Until WaitWindowEvent(10) = #PB_Event_CloseWindow
EndIf

Procedure EventDraw()
  Protected x.i = GetGadgetAttribute(#Canvas, #PB_Canvas_MouseX)
   Protected y.i = GetGadgetAttribute(#Canvas, #PB_Canvas_MouseY)
   Protected image
   
   Select EventType()
       
     Case #PB_EventType_LeftButtonDown
       Draw = #True
              
     Case #PB_EventType_LeftButtonUp
       Draw = #False
       
   EndSelect
   
   If Draw
     If StartDrawing(CanvasOutput(#Canvas))          
       Circle(x, y, 2, $000000)
       StopDrawing()
      EndIf
   EndIf
   
EndProcedure
■ L'astuce pour dessiner sans pointiller, consiste à connaitre à tout moment quel est le dernier point dessiner et le nouveau et d'utiliser LineXY() entre les deux.

le code pour vous rendre compte par vous même.

Code : Tout sélectionner

Enumeration Window
  #MainForm
EndEnumeration

Enumeration Gadgets
  #Canvas
EndEnumeration

Structure Canvas
  LeftButtonDown.i
  RightButtonDown.i
	LastX.i
	LastY.i
EndStructure

Global Draw, This.Canvas

Declare EventDraw()

If OpenWindow(#MainForm, 0, 0, 1024, 768, "Canvas Draw", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  CanvasGadget(#Canvas, 0, 0, 1024, 768)
  BindGadgetEvent(#Canvas, @EventDraw())
  
  Repeat : Until WaitWindowEvent(10) = #PB_Event_CloseWindow
EndIf

Procedure EventDraw()
  Protected x.i = GetGadgetAttribute(#Canvas, #PB_Canvas_MouseX)
	Protected y.i = GetGadgetAttribute(#Canvas, #PB_Canvas_MouseY)
		
	With This
	  Select EventType()
	    Case #PB_EventType_LeftButtonDown
	      \LeftButtonDown = #True
				\LastX = x
				\LastY = y 
				
			Case #PB_EventType_LeftButtonUp
			  \LeftButtonDown = #False
			  
			Case #PB_EventType_RightButtonDown			  
				\RightButtonDown = #True
				\lastX = x
				\lastY = y
				
			Case #PB_EventType_RightButtonUp
			  \RightButtonDown = #False
			  
			Case #PB_EventType_MouseMove	
			  Draw = #False
			  If (\LeftButtonDown Or \RightButtonDown)
						Draw = #True
			  EndIf
				
		EndSelect
		
		If Draw
		  If StartDrawing(CanvasOutput(#Canvas))
		    Protected color.l = $000000
		    
		    If (\rightButtonDown)
		      color = $ffffff ;RGB(255, 255, 255)  
		    EndIf
		   
		    LineXY(\lastX, \lastY, x, y, color)
				\lastX = x
				\lastY = y
				StopDrawing()
			EndIf
		EndIf
		
	EndWith
EndProcedure
Dernière modification par falsam le sam. 09/août/2014 9:43, modifié 1 fois.
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Dessiner sur un canvas

Message par falsam »

Le code précédent ne permettant pas de régler l'épaisseur de la ligne, j'ai remplacé LineXY() par la procédure de substitution DrawLine(x1,y1,x2,y2, color=#Black, Radius=1)

Le code précédent modifié.

Code : Tout sélectionner

Enumeration Window
  #MainForm
EndEnumeration

Enumeration Gadgets
  #Canvas
EndEnumeration

Structure Canvas
  LeftButtonDown.i
  RightButtonDown.i
  LastX.i
  LastY.i
EndStructure

Global Draw, This.Canvas

Declare EventDraw()
Declare DrawLine(x1,y1,x2,y2,color=#Black, Radius=1)

If OpenWindow(#MainForm, 0, 0, 1024, 768, "Canvas Draw", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  CanvasGadget(#Canvas, 0, 0, 1024, 768)
  BindGadgetEvent(#Canvas, @EventDraw())
  
  Repeat : Until WaitWindowEvent(10) = #PB_Event_CloseWindow
EndIf

Procedure EventDraw()
  Protected x.i = GetGadgetAttribute(#Canvas, #PB_Canvas_MouseX)
  Protected y.i = GetGadgetAttribute(#Canvas, #PB_Canvas_MouseY)
      
  With This
    Select EventType()  
      Case #PB_EventType_LeftButtonDown
        \LeftButtonDown = #True
        \LastX = x
        \LastY = y 
              
      Case #PB_EventType_LeftButtonUp
        \LeftButtonDown = #False
           
      Case #PB_EventType_RightButtonDown           
         \RightButtonDown = #True
         \lastX = x
         \lastY = y
            
      Case #PB_EventType_RightButtonUp
         \RightButtonDown = #False
           
      Case #PB_EventType_MouseMove   
         Draw = #False
         If (\LeftButtonDown Or \RightButtonDown)
           Draw = #True
         EndIf
                
     EndSelect
      
     If Draw
       If StartDrawing(CanvasOutput(#Canvas))
         Protected color.l = $000000
          
       If (\rightButtonDown)
         color = $ffffff  
       EndIf
         
       DrawLine(\lastX, \lastY, x, y, Color, 2)
       \lastX = x
       \lastY = y
       StopDrawing()  
     EndIf  
   EndIf  
 EndWith
EndProcedure

Procedure DrawLine(x1,y1,x2,y2, color=#Black, Radius=1)
  Protected n.f
  Protected c.f
  Protected x
  Protected y

  LineXY(x1,y1,x2,y2,color)
  If Radius> 1 And Radius < 180
    c=360/Radius/#PI/2/6
    n=0
    While n<360
      x=Sin(n/180*#PI) * Radius
      y=Cos(n/180*#PI) * Radius 
      LineXY(x1+x,y1+y,x2+x,y2+y,color)
      n+c  
    Wend  
  EndIf
EndProcedure
■ Pour sauvegarder une image provenant d'un canvas, utiliser la fonction SaveImage() combinée à GrabDrawingImage() entre un StartDrawing() et StopDrawing()

Code : Tout sélectionner

SaveImage(GrabDrawingImage(#PB_Any, 0, 0, 1024, 768), "image.jpg", #PB_ImagePlugin_JPEG)
sans oublier d'intialiser l'encodeur d'image jpeg.

Enjoy :)
Dernière modification par falsam le sam. 09/août/2014 9:49, modifié 1 fois.
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
graph100
Messages : 1318
Inscription : sam. 21/mai/2005 17:50

Re: Dessiner sur un canvas

Message par graph100 »

Très bien ton code falsam :wink: , j'ai bien aimé l'astuce pour dessiner une ligne épaisse !
Super l'exemple avec BindGadgetEvent() ! Fred nous a fait un gros cadeau avec ça :mrgreen:

Voici une correction du dernier code, qui permet de régler l'épaisseur de la ligne. J'ai accéléré la fonction par 5 fois, et il n'y a jamais d'artéfact.

Au lieu de trouver les points du bord avec un angle, je les calcule simplement tous.
C'est plus rapide car il n'y a que le nombre de traits qu'il faut.

et il ne faut jamais faire ça :

Code : Tout sélectionner

n/180*#PI
dans une boucle ! Lorsque c'est en radian, il faut utiliser des radians pour ne pas à avoir une division et une multiplication à faire à chaque fois

Il y a aussi une modif pour ne pas dessiner un point d'une couleur différente lorsqu'on lâche le clic droit

Code : Tout sélectionner

Structure Canvas
	IS_LeftButton.i
	IS_ButtonDown.i
	LastX.i
	LastY.i
EndStructure

Global Draw, This.Canvas


Declare EventDraw()
Declare DrawLine(x1,y1,x2,y2, Radius.d = 1, color = 0)
Declare DrawLine_(x1,y1,x2,y2, Radius.d = 1, color = 0)

If OpenWindow(0, 0, 0, 1024, 768, "Canvas Draw", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
	CanvasGadget(0, 0, 0, 1024, 768, #PB_Canvas_Keyboard)
	BindGadgetEvent(0, @EventDraw())
	
	SetActiveGadget(0)
	
	Repeat : Until WaitWindowEvent(10) = #PB_Event_CloseWindow
EndIf

Procedure EventDraw()
	Protected x.i = GetGadgetAttribute(0, #PB_Canvas_MouseX)
	Protected y.i = GetGadgetAttribute(0, #PB_Canvas_MouseY)
	
	Static r = 20
	
	Draw = #False
	
	
	With This
		Select EventType()
			Case #PB_EventType_MouseWheel
				r + GetGadgetAttribute(0, #PB_Canvas_WheelDelta) * 2
				
				If r < 1 : r = 1 : EndIf
				If r > 200 : r = 200 : EndIf
				
				
			Case #PB_EventType_LeftButtonDown
				\IS_ButtonDown = #True
				\IS_LeftButton = #True
				\LastX = x
				\LastY = y 
					Draw = #True
				
			Case #PB_EventType_LeftButtonUp
				\IS_ButtonDown = #False
				\IS_LeftButton = #True
				
			Case #PB_EventType_RightButtonDown           
				\IS_ButtonDown = #True
				\IS_LeftButton = #False
				\lastX = x
				\lastY = y
					Draw = #True
				
			Case #PB_EventType_RightButtonUp
				\IS_ButtonDown = #False
				\IS_LeftButton = #False
				
			Case #PB_EventType_MouseMove   
				If \IS_ButtonDown
					Draw = #True
				EndIf
				
		EndSelect
		
		If Draw
			If And StartDrawing(CanvasOutput(0))
				Protected color.l = $000000
				
				If \IS_LeftButton = #False
					color = $ff0000
				EndIf
				
				;{ tests de vitesse
; 				DisableDebugger
; 				time = ElapsedMilliseconds()
; 				For j = 0 To 100
; ; 					DrawLine(\lastX, \lastY, x, y, 20, Color)
; 					DrawLine(100, 100, 300, 200, r, Color)
; 				Next
; 				time = ElapsedMilliseconds() - time
; 				
; 				time1 = ElapsedMilliseconds()
; 				For j = 0 To 100
; ; 					DrawLine(\lastX, \lastY, x, y, 20, Color)
; 					DrawLine_(100, 400, 300, 500, r, Color)
; 				Next
; 				time1 = ElapsedMilliseconds() - time1
; 				
; 				EnableDebugger
; 				Debug "" + time + " - " + time1 + " -> " + StrD(time1 / time, 2)
				;}
				
				DrawLine(\lastX, \lastY, x, y, r, Color)
				
				\lastX = x
				\lastY = y
				StopDrawing()
			EndIf
		EndIf
		
	EndWith
EndProcedure


Procedure DrawLine(x1,y1,x2,y2, r.d = 1, color = 0)
	Protected.l j, l, ol, n, i
	Protected r2.d = r * r, tmp.d
	
	j = -r
	
	Circle(x2, y2, r, color)
	
	ol = 0
	
	Repeat
		j + 1
		
		tmp = r2 - j * j
		
		If tmp < 0
			Break
		EndIf
		
		l = Sqr(tmp)
		n = Sign(l - ol)
		
		i = ol - n
		Repeat
			i + n
			
			LineXY(x1 - i, y1 + j, x2 - i, y2 + j, color)
			LineXY(x1 + i, y1 + j, x2 + i, y2 + j, color)
		Until(n = 1 And i >= l) Or (n = -1 And i <= l) Or n = 0 
		
		ol = l
	ForEver
	
EndProcedure

; 3 fois plus lent en virant la conversion degree / radian
Procedure DrawLine_(x1,y1,x2,y2, Radius.d = 1, color = 0)
	Protected.d n, c, x, y
	
	LineXY(x1,y1,x2,y2,color)
	c = #PI / 2 / 6 / Radius
	
	n=0
	While n < 2 * #PI
		x=Sin(n) * Radius
		y=Cos(n) * Radius
		
		LineXY(x1+x,y1+y,x2+x,y2+y,color)
		n+c  
	Wend  
EndProcedure

; 5 fois plus lent et ne fonctionne plus lorsque radius > 180
Procedure DrawLine__(x1,y1,x2,y2, Radius.d = 1, color = 0) 
	Protected n.f 
	Protected c.f 
	Protected x 
	Protected y 
	
	LineXY(x1,y1,x2,y2,color) 
	If Radius> 1 And Radius < 180 
		c=360/Radius/#PI/2/6 
		n=0 
		While n<360 
			x=Sin(n/180*#PI) * Radius 
			y=Cos(n/180*#PI) * Radius  
			LineXY(x1+x,y1+y,x2+x,y2+y,color) 
			n+c   
		Wend   
	EndIf 
EndProcedure
_________________________________________________
Mon site : CeriseCode (Attention Chantier perpétuel ;))
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: Dessiner sur un canvas

Message par Backup »

pensez aux debutants, lorsque vous faites des exemples

utilisez les enumeration , #Canvas, #win est plus parlant que "0"
je ferai la meme remarque aux exemples de la Doc ...
Avatar de l’utilisateur
kernadec
Messages : 1594
Inscription : ven. 25/avr./2008 11:14

Re: Dessiner sur un canvas

Message par kernadec »

bonjour
Excellent!
merci pour le partage :D
Mais dans le cas d'une épaisseur des points a "0" je propose plutôt de le faire avec lineXY dans la procédure DrawLine

Maintenant reste plus qu'a faire la même chose pour les styles :mrgreen:
Cordialement

Code : Tout sélectionner

; modifications pour le code précédent afin de dessiner avec 1 pixel
;######################################
With This
  Select EventType()
    Case #PB_EventType_MouseWheel
      r + GetGadgetAttribute(0, #PB_Canvas_WheelDelta) * 2
      
      If r < 0 : r = 0 : EndIf                ; modifier le test pour avoir points a zéro dans la procédure EventDraw() 
      If r > 200 : r = 200 : EndIf

;######################################
Procedure DrawLine(x1,y1,x2,y2, r.d = 1, color = 0)
  Protected.l j, l, ol, n, i
  Protected r2.d = r * r, tmp.d
  
  j = -r
  
  if r=0
    LineXY(x2, y2, x1, y1 , color)   ; ajout d'une fonction LineXY pour r = 0
  Else
    Circle(x2, y2, r, color)
  EndIf

Dernière modification par kernadec le sam. 09/août/2014 10:13, modifié 2 fois.
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Dessiner sur un canvas

Message par falsam »

Dobro a écrit :pensez aux debutants, lorsque vous faites des exemples. utilisez les enumeration
Une seule fenêtre et un seul gadget, ça ne prêtait pas à confusion, mais tu as raison, il faut penser aux débutants. Les code précédents sont modifiés.

@Graph: Merci pour ces quelques corrections. Quand tu as parlé d'artefact je me suis dit mais "Ou a t'il pu voir un artefact ?" en grossissant l'épaisseur de la ligne (20 pts) j'ai bien vu cet artefact.

Merci aussi d'avoir ajouter le réglage de l'épaisseur de la ligne au défilement de la molette de la souris.
kernadec a écrit :Maintenant reste plus qu'a faire la même chose pour les styles
Voila .... il n'y a qu'à :mrgreen:
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: Dessiner sur un canvas

Message par Backup »

falsam a écrit :Une seule fenêtre et un seul gadget, ça ne prêtait pas à confusion, mais tu as raison, il faut penser aux débutants. Les code précédents sont modifiés.
si ça pouvait, car la fenêtre et le Gadget avait le même numéro !
lorsque tu débarques dans Purebasic , c'est pas évident de savoir que les Gadgets, et les fenêtres puissent avoir un même numéro :)
d’où la confusion possible

la Doc est rempli d'exemples fait ainsi , je me souviens que cela a été l'une de mes premières confusion justement ;)

lorsque j'ai commencé la Prg du GEM avec GFA basic , on utilisait justement des numéros pour les "Gadget" (nous appelions ça autrement mais j'ai oublié le nom)

et justement, il fallait faire gaffe que "objet" n'ait pas le même numéro

K-ressource aidait bien a la création d'interface , mais il fallait quand même bien surveillé ce point :)
comtois
Messages : 5172
Inscription : mer. 21/janv./2004 17:48
Contact :

Re: Dessiner sur un canvas

Message par comtois »

La prochaine étape serait d'utiliser l'algorithme de Bresenham modifié, par exemple :

http://www.zoo.co.uk/~murphy/thickline/index.html
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Dessiner sur un canvas

Message par falsam »

Code modifié avec la suggestion de Kernadec et Comtois.

:idea: Utiliser la molette de la souris pour modifier la largeur de la ligne.

Code : Tout sélectionner

Enumeration Window
  #MainForm
EndEnumeration

Enumeration Gadgets
  #Canvas
EndEnumeration

Structure Canvas
  IS_LeftButton.i
  IS_ButtonDown.i
  LastX.i
  LastY.i
EndStructure

Global Draw, This.Canvas

Declare EventDraw()
Declare BresenhamLine(x0 ,y0 ,x1 ,y1, Thickness, Color=$000000)

If OpenWindow(#MainForm, 0, 0, 1024, 768, "Canvas Draw", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
   CanvasGadget(#Canvas, 0, 0, 1024, 768, #PB_Canvas_Keyboard)
   BindGadgetEvent(#Canvas, @EventDraw())
   
   Repeat : Until WaitWindowEvent(10) = #PB_Event_CloseWindow
EndIf

Procedure EventDraw()
   Protected x.i = GetGadgetAttribute(#Canvas, #PB_Canvas_MouseX)
   Protected y.i = GetGadgetAttribute(#Canvas, #PB_Canvas_MouseY)
   
   Static r = 1
   
   Draw = #False
   
   With This
     Select EventType()
       Case #PB_EventType_MouseWheel
         r + GetGadgetAttribute(#Canvas, #PB_Canvas_WheelDelta) 
            
         If r < 1 : r = 1 : EndIf
         If r > 200 : r = 200 : EndIf
                  
       Case #PB_EventType_LeftButtonDown
         \IS_ButtonDown = #True
         \IS_LeftButton = #True
         \LastX = x
         \LastY = y 
         Draw = #True
              
       Case #PB_EventType_LeftButtonUp
         \IS_ButtonDown = #False
         \IS_LeftButton = #True
              
       Case #PB_EventType_RightButtonDown           
         \IS_ButtonDown = #True
         \IS_LeftButton = #False
         \lastX = x
         \lastY = y
         Draw = #True
    
       Case #PB_EventType_RightButtonUp
         \IS_ButtonDown = #False
         \IS_LeftButton = #False
            
      Case #PB_EventType_MouseMove   
         If \IS_ButtonDown
           Draw = #True
         EndIf
                
     EndSelect
      
     If Draw
       If And StartDrawing(CanvasOutput(#Canvas))
         Protected color.l = $000000
         
         If \IS_LeftButton = #False
           color = $ff0000
         EndIf
                        
         ;DrawLine(\lastX, \lastY, x, y, r, Color)
         BresenhamLine(\lastX ,\lastY ,x ,y, r, Color)
         
         \lastX = x
         \lastY = y
         StopDrawing()
         
       EndIf  
     EndIf  
   EndWith
EndProcedure


Procedure BresenhamLine(x0 ,y0 ,x1 ,y1, Thickness, Color=$000000)
  If Thickness=1 ;Suggestion de kernadec
    LineXY(x1, y1, x0, y0 , color)
    
  Else  
    
    ;Suggestion de comtois : l'algorithme de Bresenham
    If Abs(y1 - y0) > Abs(x1 - x0)
      steep =#True 
      Swap x0, y0
      Swap x1, y1  
    EndIf    
  
    If x0 > x1 
      Swap x0, x1
      Swap y0, y1  
    EndIf 
  
    deltax = x1 - x0
    deltay = Abs(y1 - y0)
    error = deltax / 2
    y = y0
    If y0 < y1  
      ystep = 1
    Else
      ystep = -1 
    EndIf 
  
    For x = x0 To x1
      If steep 
        Circle(y,x, Thickness, Color)
      Else 
        Circle(x,y, Thickness, Color)  
      EndIf
    
      error - deltay
      If error < 0 
        y + ystep
        error + deltax
      EndIf  
    Next    
  EndIf 
EndProcedure
PS : l'algorithme de Bresenham n'est pas codé par moi
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
graph100
Messages : 1318
Inscription : sam. 21/mai/2005 17:50

Re: Dessiner sur un canvas

Message par graph100 »

Cette nouvelle procedure est vraiment, vraiment plus lente.

dessiner avec des cercles est très couteux en temps !
_________________________________________________
Mon site : CeriseCode (Attention Chantier perpétuel ;))
comtois
Messages : 5172
Inscription : mer. 21/janv./2004 17:48
Contact :

Re: Dessiner sur un canvas

Message par comtois »

graph100 a écrit :Cette nouvelle procedure est vraiment, vraiment plus lente.

dessiner avec des cercles est très couteux en temps !
C'est clair, dessiner des cercles perd tout l'intérêt de l'algo de bresenham . La mise en oeuvre de l'algo modifié est moins simple mais sûrement plus efficace :)
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.
Avatar de l’utilisateur
graph100
Messages : 1318
Inscription : sam. 21/mai/2005 17:50

Re: Dessiner sur un canvas

Message par graph100 »

il s'agit à mon avis de dessiner ligne par ligne. Dans ce cas, chaque pixel est dessiné une seule fois.
Dans mon algo, chaque pixel est dessiné 2fois, ce qui montre qu'on peut accélérer le dessin.
Dans celui de faslam initial, je dirais que chaque pixel est dessiné environ 3 fois + que le moins, c'est à dire environ 6 fois.

C'est le dessin qui prend beaucoup de temps !
_________________________________________________
Mon site : CeriseCode (Attention Chantier perpétuel ;))
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Dessiner sur un canvas

Message par falsam »

l'algorithme de Bresenham suggéré par Comtois est intéressant car il permet d'obtenir une ligne moins crénelé. Par contre, c'est vrai il va consommé un peu plus de ressource pour chaque point. Mais ça reste visuellement négligeable :)
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
graph100
Messages : 1318
Inscription : sam. 21/mai/2005 17:50

Re: Dessiner sur un canvas

Message par graph100 »

comtois a écrit :
graph100 a écrit :Cette nouvelle procedure est vraiment, vraiment plus lente.

dessiner avec des cercles est très couteux en temps !
C'est clair, dessiner des cercles perd tout l'intérêt de l'algo de bresenham . La mise en oeuvre de l'algo modifié est moins simple mais sûrement plus efficace :)
Ce n'est pas une question de créneaux. Cet algo permet de parcourir la surface du trait épais qu'une seule fois !

Bref, un code est plus clair :

-> ma fonction WideLine() modifiée pour aller 2*fois plus vite (qu'avant)
-> la fonction bresenhamLine() qui est en règle générale un peu plus rapide. (mais pas bcp, et sérieusement, pour la galère que c'est à faire, je préfère l'autre)

Le tout dans un module "Draw".
Je me suis dis que si on faisait d'autres fonctions de dessin "native" PB, ça pourrait être intéressant de les regrouper dans un seul module !

Code : Tout sélectionner

DeclareModule Draw
	
	Declare WideLine(x1,y1,x2,y2, Thickness, color = 0)
	Declare BresenhamLine(x0 ,y0 ,x1 ,y1, Thickness, Color = 0)
	
EndDeclareModule


Module Draw
	
	Procedure WideLine(x1,y1,x2,y2, Thickness, color = 0)
		
		If Thickness = 0
			LineXY(x1, y1, x2, y2, color)
			ProcedureReturn
		Else
			Circle(x2, y2, Thickness, color)
		EndIf
		
		Protected.l j, l, ol, n, i
		Protected r2.d = Thickness * Thickness, tmp.d
		
		j = -Thickness - 1
		
		
		u.d = x2 - x1
		v.d = y2 - y1
		
		ol = 0
		
		
		Repeat
			j + 1
			
			tmp = r2 - j * j
			
			If tmp < 0
				If j > 0
					Break
				EndIf
			Else
				
				l = Sqr(tmp)
				n = Sign(l - ol)
				
				i = ol - n
				Repeat
					i + n
					
					tmp = - v * j
					
					If tmp + u * i >= 0
						LineXY(x1 - i, y1 + j, x2 - i, y2 + j, color)
					EndIf
					
					If tmp - u * i >= 0
						LineXY(x1 + i, y1 + j, x2 + i, y2 + j, color)
					EndIf
					
				Until(n = 1 And i >= l) Or (n = -1 And i <= l) Or n = 0 
			EndIf
			
			ol = l
		ForEver
		
	EndProcedure
	
	Procedure BresenhamLine(x0 ,y0 ,x1 ,y1, Thickness, Color = 0)
		If Thickness = 0 ;Suggestion de kernadec
			LineXY(x1, y1, x0, y0 , color)
			
		Else  
			
			Circle(x0, y0, Thickness, Color)
			Circle(x1, y1, Thickness, Color)
			
			;Suggestion de comtois : l'algorithme de Bresenham
			If Abs(y1 - y0) > Abs(x1 - x0)
				steep =#True 
				Swap x0, y0
				Swap x1, y1  
			EndIf    
			
			If x0 > x1 
				Swap x0, x1
				Swap y0, y1  
			EndIf 
			
			deltax = x1 - x0
			deltay = Abs(y1 - y0)
			
			L.d = Sqr(deltax * deltax + deltay * deltay)
			
			If L < 2
				ProcedureReturn 
			EndIf
			
			error = deltax / 2
			
			If y0 < y1  
				ystep = 1
			Else
				ystep = -1 
			EndIf 
			
			
			h1.d = L * Thickness / deltax
			
			h2D.d = deltay * Thickness / L
			h2.l = h2D
			h22.d = h1 / (h2D * 2)
			
			y = y0 - ystep * deltay * h2 / deltax
			
			x1_p_h2 = x1 + h2
			x0_p_h2 = x0 + h2
			x1_m_h2 = x1 - h2
			
			
			For x = x0 - h2 To x1_p_h2
				If ystep = 1
					If x < x0_p_h2
						h = 0
					Else
						h = h1
					EndIf
					
					If x > x1_m_h2
						h3 = 0
					Else
						h3 = h1
					EndIf
				Else
					If x < x0_p_h2
						h3 = 0
					Else
						h3 = h1
					EndIf
					
					If x > x1_m_h2
						h = 0
					Else
						h = h1
					EndIf
				EndIf
				
				If steep
					LineXY(y - h, x, y + h3, x, Color)
				Else 
					LineXY(x, y - h, x, y + h3, Color)
				EndIf
				
				error - deltay
				
				If error <= 0
					y + ystep
					error + deltax
				EndIf  
			Next
			
		EndIf 
	EndProcedure
	
EndModule

;{ exemple

CompilerIf #PB_Compiler_IsMainFile
	
#WD_main = 0
#GD_canvas = 0


Structure Canvas
	IS_LeftButton.i
	IS_ButtonDown.i
	LastX.i
	LastY.i
EndStructure


Procedure EventDraw()
	Protected x.i = GetGadgetAttribute(#GD_canvas, #PB_Canvas_MouseX)
	Protected y.i = GetGadgetAttribute(#GD_canvas, #PB_Canvas_MouseY)
	Static r = 20, This.Canvas
	
	Static Mode = 0
	
	Draw = #False
	
	
	With This
		Select EventType()
			Case #PB_EventType_KeyUp
				
				If GetGadgetAttribute(#GD_canvas, #PB_Canvas_Key) = #PB_Shortcut_W
					mode = 0
				ElseIf GetGadgetAttribute(#GD_canvas, #PB_Canvas_Key) = #PB_Shortcut_B
					mode = 1
				Else
					StartDrawing(CanvasOutput(#GD_canvas))
					
					Box(0, 0, OutputWidth(), OutputHeight(), $ffffff)
					
					StopDrawing()
				EndIf
				
			Case #PB_EventType_MouseWheel
				r + GetGadgetAttribute(#GD_canvas, #PB_Canvas_WheelDelta) * 1
				
				If r < 0 : r = 0 : EndIf
				If r > 200 : r = 200 : EndIf
				
			Case #PB_EventType_LeftButtonDown
				\IS_ButtonDown = #True
				\IS_LeftButton = #True
				\LastX = x
				\LastY = y 
					Draw = #True
				
			Case #PB_EventType_LeftButtonUp
				\IS_ButtonDown = #False
				\IS_LeftButton = #True
				
			Case #PB_EventType_RightButtonDown           
				\IS_ButtonDown = #True
				\IS_LeftButton = #False
				\lastX = x
				\lastY = y
					Draw = #True
				
			Case #PB_EventType_RightButtonUp
				\IS_ButtonDown = #False
				\IS_LeftButton = #False
				
			Case #PB_EventType_MouseMove   
				If \IS_ButtonDown
					Draw = #True
				EndIf
				
		EndSelect
		
		If Draw
			If And StartDrawing(CanvasOutput(#GD_canvas))
				Protected color.l = $000000
				
				If \IS_LeftButton = #False
					color = $ff0000
				EndIf
				
				;{ vitesse
; 				
; 				t = 100
; 				
; 				DisableDebugger
; 				time = ElapsedMilliseconds()
; 				For i = 0 To t
; 					Draw::WideLine(100, 100, 500, 200, r, color)
; 				Next
; 				time = ElapsedMilliseconds() - time
; 				
; 				time1 = ElapsedMilliseconds()
; 				For i = 0 To t
; 					Draw::BresenhamLine(100, 300, 500, 400, r, color)
; 				Next
; 				time1 = ElapsedMilliseconds() - time1
; 				EnableDebugger
; 				
; 				Debug " rayon = " + r + " : " + time + " - " + time1 + " -> " + StrD(time1 / time, 2)
; 				
				;}
				
				If mode = 0
					Draw::WideLine(\lastX, \lastY, x, y, r, Color)
					
					DrawText(0, 0, "[W/B] : MODE = WideLine          ")
				Else
					Draw::BresenhamLine(\lastX, \lastY, x, y, r, Color)
					
					DrawText(0, 0, "[W/B] : MODE = BresenhamLine")
				EndIf
				
				\lastX = x
				\lastY = y
				StopDrawing()
			EndIf
		EndIf
		
	EndWith
EndProcedure

OpenWindow(#WD_main, 0, 0, 1024, 768, "Canvas Draw", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
CanvasGadget(#GD_canvas, 0, 0, 1024, 768, #PB_Canvas_Keyboard)
BindGadgetEvent(#GD_canvas, @EventDraw())

SetActiveGadget(#GD_canvas)

Repeat : Until WaitWindowEvent(10) = #PB_Event_CloseWindow

CompilerEndIf

;}
détails sur la comparaison en vitesse des 2 fonctions :

thickness = 0 :
idem (puisque = lineXY() )

thickness < 20 :
WideLine() est plus rapide que BresenhamLine()

thickness >= 20 & thickness < 100
BresenhamLine() est plus rapide que WideLine()

thickness >= 100
il semble que WideLine() soit à nouveau plus rapide.
_________________________________________________
Mon site : CeriseCode (Attention Chantier perpétuel ;))
Répondre