PureBasic Forums - English

Posted: **Thu Sep 16, 2010 7:09 pm**

; Thanks to 'Le Soldat Inconnu' For introducing Wu Anti-Alias Algorithm to PB
; Thanks to 'Kenmo' for his arrow procedure
; Thanks to 'einander' ,'Demevic' and 'MV' for their arrow lines code
; Thanks to 'galah' for Bresenham line drawing Algorithm

; That was the real HELP for this piece of code
; Todo list :
; 1- Fix some bugs
; 2- Optimizing the code
; 3- Add More Lines Style
; 4- Add at Least 3 Arrow Head styles

Code: Select all

Global x1,y1,x2,y2

ProcedureDLL.l ColorBlending(Color1.l, Color2.l, Blend.f)
  Protected Red, Green, Blue, Red2, Green2, Blue2
 
  Red = Color1 & $FF
  Green = Color1 >> 8 & $FF
  Blue = Color1 >> 16
  Red2 = Color2 & $FF
  Green2 = Color2 >> 8 & $FF
  Blue2 = Color2 >> 16
 
  Red = Red * Blend + Red2 * (1-Blend)
  Green = Green * Blend + Green2 * (1-Blend)
  Blue = Blue * Blend + Blue2 * (1-Blend)
 
  ProcedureReturn (Red | Green <<8 | Blue << 16)
EndProcedure

Procedure NormalL(X,Y, x3, y3, Color, Thickness = 1)
  Width = x3-X
  Hight = y3-Y
  Protected SignX, SignY, n, nn, Thick.f, x2.f, y2.f, Color_Found.l, Application.f, Hypo.f
  
  If Width >= 0
    SignX = 1
  Else
    SignX = -1
    Width = - Width
  EndIf
  If Hight >= 0
    SignY = 1
  Else
    SignY = -1
    Hight = - Hight
  EndIf  
 
 
  Thick.f = Thickness / 2
 
  Hypo.f = Sqr(Width * Width + Hight * Hight)
  CosPhi.f = Width / Hypo
  SinPhi.f = -Sin(ACos(CosPhi))
 
  
  For n = -Thickness To Width + Thickness
    For nn = -Thickness To Hight + Thickness
     

      x2 = n * CosPhi - nn * SinPhi
      y2 = Abs(n * SinPhi + nn * CosPhi)
     
      If y2 <= Thick + 0.5
        Application =  0.5 + Thick - y2
        If Application > 1
          Application = 1
        EndIf
        If x2 > -1 And x2 < Hypo + 1
          If x2 < 0
            Application * (1 + x2)
          ElseIf x2 > Hypo
            Application * (1 - x2 + Hypo)
          EndIf
        Else
          Application = 0
        EndIf
        If Application > 0
          If Application < 1
            Color_Found = Point(X + n * SignX, Y + nn * SignY)
            Plot(X + n * SignX, Y + nn * SignY, ColorBlending(Color, Color_Found, Application))
          Else
            Plot(X + n * SignX, Y + nn * SignY, Color)
          EndIf
        EndIf
      EndIf     
    Next
  Next
 
EndProcedure


Procedure ArrowL(x1.l, y1.l, x2.l, y2.l, Color.l,Thick.f, Llength.f, Angle.f)
  If Llength = 0
    Llength = 0.05*(Sqr((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1)))
  EndIf
  Llength = Abs(Llength) : Angle = Abs(Angle*#PI/180.0)
  NormalL(x1, y1,x2, y2,Color,Thick)
  If (Llength > 0.0) And (Abs(x2 - x1) + Abs(y2 - y1) > Llength)
    x33.f = -1*Cos(Angle) * Llength
    y33.f =    Sin(Angle) * Llength
    x44.f = -1*Cos(Angle) * Llength
    y44.f = -1*Sin(Angle) * Llength
    
    SAngle.f = ATan((y1 - y2)/(x2 - x1))
    If (x2 < x1)
      SAngle = SAngle + #PI
    EndIf
    
    x3 = Cos(SAngle)*x33 + Sin(SAngle)*y33
    y3 = Cos(SAngle)*y33 - Sin(SAngle)*x33
    x4 = Cos(SAngle)*x44 + Sin(SAngle)*y44
    y4 = Cos(SAngle)*y44 - Sin(SAngle)*x44    
    
    NormalL(x2, y2,x2+x3,y2+y3, Color,Thick)
    NormalL(x2, y2,x2+x4,y2+y4, Color,Thick)
    If Thick > 4
      Circle(x2,y2,Thick/2,Color)
      Circle(x1,y1,Thick/2,Color)
    EndIf
  EndIf
EndProcedure

Procedure DashL(x1.i, y1.i, x2.i, y2.i, Color.i,Thick.f, Lstep.f)
 scale.f = (y2-y1)/(x2-x1)
 For i = 0 To 10
    NormalL(x1,y1,x1+Lstep,y1+Lstep*scale,Color,Thick)
    x1 = x1+Lstep + Lstep
    y1 = y1+2*Lstep*scale
 Next
EndProcedure

Procedure DashDotL(x1.i, y1.i, x2.i, y2.i, Color.i,Thick.f,Lstep.f)
   scale.f = (y2-y1)/(x2-x1)
 For i = 0 To 10
   NormalL(x1,y1,x1+Lstep,y1+Lstep*scale,Color, Thick)
   If Thick = 1
      Circle(x1+Lstep + Lstep/2,y1+1.5*Lstep*scale,Thick,Color)
   Else
     Circle(x1+Lstep + Lstep/2,y1+1.5*Lstep*scale,Thick/2,Color)
   EndIf
    x1 = x1+Lstep + Lstep
    y1 = y1+2*Lstep*scale
 Next
EndProcedure


OpenWindow(0, 0, 0, 500, 500, "Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget)

CreateImage(0, 500, 500)
StartDrawing(ImageOutput(0))

ArrowL(10,400,400,10,$01FFFE,3,40,30)           ;ArrowL(x1,y1,x2,y2,Color,Line Thickness,Arrow Leg Length,Inclined Angle)
ArrowL(100,200,280,350,$06BCF9,2,30,35)
ArrowL(60,20,420,350,$6FF690,16,50,30)
ArrowL(480,480,10,10,$0104FE,6,50,30)
ArrowL(10,480,30,450,$FFFFFF,1,5,30)

NormalL(5,5,400,100,$01FFFE,4)                  ;NormalL(x1,y1,x2,y2,Color,Line Thickness)

DashL(10,10,400,150,$01FFFE,4,20)               ;DashL(x1,y1,x2,y2,Color,Line Thickness,Interval)

DashDotL(40,60,400,280,$FC0503,8,20)            ;DashDotL(x1,y1,x2,y2,Color,Line Thickness,Interval)

DashDotL(40,60,400,380,$FFFFFF,1,20)

StopDrawing()

ImageGadget(0, 0, 0, 500, 500, ImageID(0))

Repeat
  Event = WaitWindowEvent()
 
  Select Event

  EndSelect
 
Until Event = #PB_Event_CloseWindow

End

Tested on Windows 7 x64

Posted: **Thu Sep 16, 2010 7:17 pm**

Very nice.

Posted: **Fri Sep 17, 2010 4:41 am**

Ha, what a nice surprise.... I was going to compliment the author(s) of this nice code, and I noticed I was one of them!

Very useful, I may borrow from this soon....

Posted: **Fri Sep 17, 2010 8:48 am**

Hi Rashad,

works great on PB4.51, Mac OS X.
Thanks for sharing!

Posted: **Fri Sep 17, 2010 10:22 am**

Dear Rashad,

thanks for putting these together

[though I'm not sure what you want to point out]

besides - runs well on Linux (Suse 11.1) too

cheers ~ Vera

Posted: **Fri Sep 17, 2010 12:52 pm**

Nice

Thanks for sharing.

cheers

Posted: **Fri Sep 17, 2010 1:18 pm**

Like usualy it's Great !!!!

It's funny but you have a little bit the same idea that SROD at the same moment

http://www.purebasic.fr/english/viewtop ... 19#p334119
Make ARROW in a window...perhaps there are indian in this forum

Congratulation RASHAD and thanks a lot for sharing your knowledge

Posted: **Fri Sep 17, 2010 1:20 pm**

Very useful. Thanks!

Posted: **Sat Sep 18, 2010 1:11 am**

@Vera and The boys
Thank you very much for everything
As I promised, some more ArrowHead Styles

Code: Select all


Global x1,y1,x2,y2

ProcedureDLL.l ColorBlending(Color1.l, Color2.l, Blend.f)
  Protected Red, Green, Blue, Red2, Green2, Blue2
 
  Red = Color1 & $FF
  Green = Color1 >> 8 & $FF
  Blue = Color1 >> 16
  Red2 = Color2 & $FF
  Green2 = Color2 >> 8 & $FF
  Blue2 = Color2 >> 16
 
  Red = Red * Blend + Red2 * (1-Blend)
  Green = Green * Blend + Green2 * (1-Blend)
  Blue = Blue * Blend + Blue2 * (1-Blend)
 
  ProcedureReturn (Red | Green <<8 | Blue << 16)
EndProcedure

Procedure NormalL(X,Y, x3, y3, Color, Thickness = 1)
  Width = x3-X
  Hight = y3-Y
  Protected SignX, SignY, n, nn, Thick.f, x2.f, y2.f, Color_Found.l, Application.f, Hypo.f
  
  If Width >= 0
    SignX = 1
  Else
    SignX = -1
    Width = - Width
  EndIf
  If Hight >= 0
    SignY = 1
  Else
    SignY = -1
    Hight = - Hight
  EndIf  
 
 
  Thick.f = Thickness / 2
 
  Hypo.f = Sqr(Width * Width + Hight * Hight)
  CosPhi.f = Width / Hypo
  SinPhi.f = -Sin(ACos(CosPhi))
 
  
  For n = -Thickness To Width + Thickness
    For nn = -Thickness To Hight + Thickness
     

      x2 = n * CosPhi - nn * SinPhi
      y2 = Abs(n * SinPhi + nn * CosPhi)
     
      If y2 <= Thick + 0.5
        Application =  0.5 + Thick - y2
        If Application > 1
          Application = 1
        EndIf
        If x2 > -1 And x2 < Hypo + 1
          If x2 < 0
            Application * (1 + x2)
          ElseIf x2 > Hypo
            Application * (1 - x2 + Hypo)
          EndIf
        Else
          Application = 0
        EndIf
        If Application > 0
          If Application < 1
            Color_Found = Point(X + n * SignX, Y + nn * SignY)
            Plot(X + n * SignX, Y + nn * SignY, ColorBlending(Color, Color_Found, Application))
          Else
            Plot(X + n * SignX, Y + nn * SignY, Color)
          EndIf
        EndIf
      EndIf     
    Next
  Next
 
EndProcedure


Procedure ArrowL(x1.l, y1.l, x2.l, y2.l, Color.l,Thick.f, Llength.f, Angle.f,AStyle.l)
  If Llength = 0
    Llength = 0.05*(Sqr((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1)))
  EndIf
  Llength = Abs(Llength) : Angle = Abs(Angle*#PI/180.0)
  NormalL(x1, y1,x2, y2,Color,Thick)
  If (Llength > 0.0) And (Abs(x2 - x1) + Abs(y2 - y1) > Llength)
    x33.f = -1*Cos(Angle) * Llength
    y33.f =    Sin(Angle) * Llength
    x44.f = -1*Cos(Angle) * Llength
    y44.f = -1*Sin(Angle) * Llength
    
    SAngle.f = ATan((y1 - y2)/(x2 - x1))
    If (x2 < x1)
      SAngle = SAngle + #PI
    EndIf
    
    x3 = Cos(SAngle)*x33 + Sin(SAngle)*y33
    y3 = Cos(SAngle)*y33 - Sin(SAngle)*x33
    x4 = Cos(SAngle)*x44 + Sin(SAngle)*y44
    y4 = Cos(SAngle)*y44 - Sin(SAngle)*x44    
    
    NormalL(x2, y2,x2+x3,y2+y3, Color,Thick)
    NormalL(x2, y2,x2+x4,y2+y4, Color,Thick)
      x5 = (x2+(x3+x4)/2)
      y5 = (y2+(y3+y4)/2)
      If x2 < x5
        sx = -1
       Else
        sx = 1
      EndIf
      If y2 < y5
        sy = -1
      Else
        sy = 1
      EndIf
    If AStyle = 1
      NormalL(x2+x3,y2+y3,x2+x4,y2+y4, Color,Thick)
      FillArea(x5+(sx*8), y5, Color, Color)
      FillArea(x5, y5+(sy*8), Color, Color)
    ElseIf AStyle = 2
      NormalL(x2+x3,y2+y3,x5+(sx*8),y5+(sy*8), Color,Thick)
      NormalL(x2+x4,y2+y4,x5+(sx*8),y5+(sy*8), Color,Thick)
      FillArea((x2+x5+(sx*8))/2-(sx*2),(y2+y5+(sy*8))/2+(sy*2), Color, Color)
      FillArea((x2+x5+(sx*8))/2+(sx*2),(y2+y5+(sy*8))/2-(sy*2), Color, Color)
    ElseIf AStyle = 3
      NormalL(x2+x3,y2+y3,x5+(sx*8),y5+(sy*8), Color,Thick)
      NormalL(x2+x4,y2+y4,x5+(sx*8),y5+(sy*8), Color,Thick)
      ;FillArea((x2+x5+(sx*8))/2-(sx*2),(y2+y5+(sy*8))/2+(sy*2), Color, Color)
      FillArea((x2+x5+(sx*8))/2+(sx*2),(y2+y5+(sy*8))/2-(sy*2), Color, Color)      
    EndIf
    If Thick > 4
      Circle(x2,y2,Thick/2,Color)
      Circle(x1,y1,Thick/2,Color)
    EndIf
  EndIf
EndProcedure

Procedure DashL(x1.i, y1.i, x2.i, y2.i, Color.i,Thick.f, Lstep.f)
 scale.f = (y2-y1)/(x2-x1)
 For i = 0 To 10
    NormalL(x1,y1,x1+Lstep,y1+Lstep*scale,Color,Thick)
    x1 = x1+Lstep + Lstep
    y1 = y1+2*Lstep*scale
 Next
EndProcedure

Procedure DashDotL(x1.i, y1.i, x2.i, y2.i, Color.i,Thick.f,Lstep.f)
   scale.f = (y2-y1)/(x2-x1)
 For i = 0 To 10
   NormalL(x1,y1,x1+Lstep,y1+Lstep*scale,Color, Thick)
   If Thick = 1
      Circle(x1+Lstep + Lstep/2,y1+1.5*Lstep*scale,Thick,Color)
   Else
     Circle(x1+Lstep + Lstep/2,y1+1.5*Lstep*scale,Thick/2,Color)
   EndIf
    x1 = x1+Lstep + Lstep
    y1 = y1+2*Lstep*scale
 Next
EndProcedure


OpenWindow(0, 0, 0, 500, 500, "Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget)

CreateImage(0, 500, 500)
StartDrawing(ImageOutput(0))

ArrowL(10,400,400,10,$01FFFE,3,40,30,2)           ;ArrowL(x1,y1,x2,y2,Color,Line Thickness,Arrow Leg Length,Inclined Angle,Arrow Style)
ArrowL(100,200,280,350,$06BCF9,2,30,35,3)         ;Arrow Style : 0, 1, 2, 3
ArrowL(60,20,420,350,$6FF690,16,50,30,0)
ArrowL(480,480,10,10,$0104FE,4,50,30,1)
ArrowL(10,480,30,450,$FFFFFF,1,8,30,0)

NormalL(5,5,400,100,$01FFFE,4)                    ;NormalL(x1,y1,x2,y2,Color,Line Thickness)

DashL(10,10,400,150,$01FFFE,4,20)                 ;DashL(x1,y1,x2,y2,Color,Line Thickness,Interval)

DashDotL(40,60,400,280,$FC0503,8,20)              ;DashDotL(x1,y1,x2,y2,Color,Line Thickness,Interval)

DashDotL(40,60,400,380,$FFFFFF,1,20)

StopDrawing()

ImageGadget(0, 0, 0, 500, 500, ImageID(0))

Repeat
  Event = WaitWindowEvent()
 
  Select Event

  EndSelect
 
Until Event = #PB_Event_CloseWindow

End

Posted: **Sat Sep 18, 2010 1:35 am**

@RASHAD: Nice addition. Just a comment for the arrowheads, if you use FillArea() itmay fail if drawing over previously drawn graphics.

Posted: **Sat Sep 18, 2010 1:56 am**

Yes ,may be but in a very rare cases I can not imagine
Because I am filling the area surrounded by the same color of the arrowhead

Posted: **Wed Jun 24, 2015 11:59 am**

Hi

Sorry to bump an old thread, but i'm looking for a way to create beautifull anti-aliased strokes, for my painting application.

I have tried the procedure, in the first code :

Code: Select all

 NormalL(X,Y, x3, y3, Color, Thickness = 1)

I have just made some changes to have the alpha for the color (but it's bugued with alpha) :

Code: Select all

If Application > 0
     xxx = X + n * SignX
     yyy = Y + nn * SignY
     If xxx >=0 And xxx < ScreenWidth()-1 And yyy>=0 And yyy < ScreenHeight()-1
        If Application < 1             
           Plot(xxx, yyy, RGBA(Red(Color), Green(color),Blue(color),Alpha(color)*0.3))   ; to have a better AA, we can change 0.3 by 0.5  or another value      
        Else
           Plot(xxx, yyy, RGBA(Red(Color), Green(color),Blue(color),Alpha(color)))             
        EndIf
     EndIf
 EndIf

And it works fine for smal sized line (with hand drawned lines), but not when I use a big size.
Here is a picture for the resultat (problem) :

Do you know how I can fixe that ?

Posted: **Tue Jul 21, 2015 9:44 am**

anti aliasing can be easily obtained by Purebasic

drawing on a larger than desired picture
then resizing the image to anti aliasing

example with this code

Delta = 1 no anti alias
if Delta = 2 or 4 Anti Alias !!

Code: Select all

;***********************************************
;Titre  :*bezier +anti Alias
;Auteur  : Dobro
;Date  :20/07/2015
;Heure  :16:52:59
;Version Purebasic :  PureBasic 5.31 (Windows - x86)
;Version de l'editeur :EPB V2.62
; Libairies necessaire : Aucune
; Principe :
; on dessine sur une image plus grande , puis on reduit
; l'interpolation de la reduction applique de lui meme l'antialias !
; c'est la methode : Oversampling ... 
;***********************************************
Enumeration
	#win
	#image
	#canvas
EndEnumeration
declare  bezier(x1,y1,x2,y2,x3,y3,x4,y4,color)
OpenWindow(#win,0,0,800,600,"PAINT")
CanvasGadget(#canvas,0,0,800,600,#PB_Canvas_ClipMouse)
mx.i
my.i
paint.b = #True
While #True
	Repeat
		event = WindowEvent()
		If event = #PB_Event_CloseWindow
			Break 2
		EndIf
		If event = #PB_Event_Gadget
			If EventGadget() = 0
				Select EventType()
					Case #PB_EventType_MouseMove
					mx = GetGadgetAttribute(0,#PB_Canvas_MouseX)
					my = GetGadgetAttribute(0,#PB_Canvas_MouseY)
					Case #PB_EventType_LeftButtonDown
					paint = #True
					Case #PB_EventType_LeftButtonUp
					paint = #False
				EndSelect
			EndIf
		EndIf
	Until event = 0
	If paint
		; ******************** exemple d'utilisation ***************************************
		couleur_dessin=rgb(255,0,0)
		delta=2 ; 1= pas d'anti Alias   .. a partir de 2 =Anti Alias !!
		CreateImage(#image,800*delta,600*delta,32,rgb(255,255,255)) ; on creer une image "delta" plus grande que le canvas
		StartDrawing(imageOutput(#image)) ; on dessine notre bezier dedans 
			circle(200*delta,150*delta,10*delta,rgb(255,0,0)) ; point x2,y2 de la courbe bezier (point de control)
			circle(400*delta,10*delta,10*delta,rgb(0,0,255)) ; point x3,y3  de la courbe bezier (point de control)
			bezier(10*delta ,10*delta,200*delta,150*delta,400*delta,10*delta,400*delta,400*delta,couleur_dessin)
			DrawingMode(#PB_2DDrawing_Outlined )
			for i=1 to 50 
			circle(random(800,20)*delta,(random(600,20)+i)*delta,random(200,20)*delta,rgb(0,0,0))
			next i
			
			
			xf = mx
			yf = my
		StopDrawing()
		; ************* anti alias ****************
		ResizeImage(#image,800,600) ; on redimentionne l'image au format du canvas (800x600) ça creer l'antialiasing en meme temps
		StartDrawing(CanvasOutput(#canvas))
			DrawAlphaImage(imageId(#image),0,0) ; on colle notre image redimenssioné dans le canvas
		StopDrawing()
		; *********************************************************************
	EndIf
	paint=#False
Wend

Procedure bezier(x1,y1,x2,y2,x3,y3,x4,y4,color)
	oldx=x1
	oldy=y1
	cx.f=3*(x2-x1)
	bx.f=3*(x3-x2)-cx
	ax.f=x4-x1-cx-bx
	cy.f=3*(y2-y1)
	by.f=3*(y3-y2)-cy
	ay.f=y4-y1-cy-by
	While i.f < 1
		i+0.05
		x=((ax*i+bx)*i+cx)*i+x1
		y=((ay*i+by)*i+cy)*i+y1
		If i>0: LineXY(oldx,oldy,x,y,color) : EndIf
		oldx=x
		oldy=y
	Wend
EndProcedure
;


; 
; Epb

more simpler than that, you're dead!

https://en.wikipedia.org/wiki/Anti-aliasing_filter
Oversampling methode

Posted: **Tue Jul 21, 2015 2:09 pm**

dobro wrote:more simpler than that, you're dead!

Posted: **Tue Jul 21, 2015 4:52 pm**

ha bah , l'anglais n'est pas mon fort ... zon qu'a parler français comme tout le monde

PureBasic Forums - English

Lines Anti-Aliased

Lines Anti-Aliased

Re: Lines Anti-Aliased

Re: Lines Anti-Aliased

Re: Lines Anti-Aliased

Re: Lines Anti-Aliased

Re: Lines Anti-Aliased

Re: Lines Anti-Aliased

Re: Lines Anti-Aliased

Re: Lines Anti-Aliased

Re: Lines Anti-Aliased

Re: Lines Anti-Aliased

Re: Lines Anti-Aliased

Re: Lines Anti-Aliased

Re: Lines Anti-Aliased

Re: Lines Anti-Aliased