[v4.40b5] Custom Filters() - post your useful filter here

Share your advanced PureBasic knowledge/code with the community.
User avatar
Demivec
Addict
Addict
Posts: 4270
Joined: Mon Jul 25, 2005 3:51 pm
Location: Utah, USA

[v4.40b5] Custom Filters() - post your useful filter here

Post by Demivec »

Code updated for 5.20+, including all filters posted here before 2013

I just thought I start a group topic where individuals can post useful CustomFilters() that they've come up with. It seemed like a good way to do it instead of having many different threads. Take your pick.

Postings would need a short description and the myCallback() procedure that would be used with CustomFilterCallback(@myCallback()).

Here's a CustomFilter() start it off:

Code: Select all

;Transfer the Alpha layer into the visible layer.
Procedure MakeAlphaVisibleFilterCallback(x, y, SourceColor, TargetColor)
  ProcedureReturn RGBA(Alpha(SourceColor), Alpha(SourceColor),Alpha(SourceColor),00)
EndProcedure
@Edit: updated thread title to [v4.40b5]
Last edited by Demivec on Mon Oct 26, 2009 8:14 pm, edited 1 time in total.
Seymour Clufley
Addict
Addict
Posts: 1265
Joined: Wed Feb 28, 2007 9:13 am
Location: London

Post by Seymour Clufley »

I think this thread is a great idea and will in future contribute any filters that I make to it.

However, for the sake of consistency I've added my Photoshop modes to the original thread. They are updated to work as Custom Filter callbacks.
JACK WEBB: "Coding in C is like sculpting a statue using only sandpaper. You can do it, but the result wouldn't be any better. So why bother? Just use the right tools and get the job done."
User avatar
Demivec
Addict
Addict
Posts: 4270
Joined: Mon Jul 25, 2005 3:51 pm
Location: Utah, USA

Post by Demivec »

The code for these filters is adapted from code posted by wilbert.

Code: Select all

;Overlay horizontal scanlines by reducing color and leaving Alpha unchanged
Procedure HorizontalScanlines(x,y,SourceColor,TargetColor)
  If y % 2
    ProcedureReturn RGBA(Red(TargetColor) * 0.1, Green(TargetColor) * 0.1, Blue(TargetColor) * 0.1, Alpha(TargetColor))
  Else
    ProcedureReturn TargetColor
  EndIf
EndProcedure


;Overlay vertical scanlines by reducing color and leaving Alpha unchanged
Procedure VerticalScanlines(x,y,SourceColor,TargetColor)
  If x % 2
    ProcedureReturn RGBA(Red(TargetColor) * 0.1, Green(TargetColor) * 0.1, Blue(TargetColor) * 0.1, Alpha(TargetColor))
  Else
    ProcedureReturn TargetColor
  EndIf
EndProcedure
User avatar
eddy
Addict
Addict
Posts: 1479
Joined: Mon May 26, 2003 3:07 pm
Location: Nantes

Post by eddy »

  • diagonal scanlines
  • inverted colors
  • grayscale
  • darken
  • lighten

Code: Select all

;Overlay diagonal scanlines by reducing color and leaving Alpha unchanged 
Procedure DiagonalScanlines(x,y,SourceColor,TargetColor) 
  If ((x+y) % 3) 
    ProcedureReturn RGBA(Red(TargetColor) * 0.1, Green(TargetColor) * 0.1, Blue(TargetColor) * 0.1, Alpha(TargetColor)) 
  Else 
    ProcedureReturn TargetColor 
  EndIf 
EndProcedure

;invert color and keep alpha layer
Procedure InvertedColors(x,y,SourceColor,TargetColor) 
    ProcedureReturn  TargetColor ! $FFFFFF
EndProcedure

;convert color to grayscale
Procedure GrayscaleFilter(x,y,SourceColor,TargetColor) 
    grayLevel=(Red(TargetColor)+Green(TargetColor)+Blue(TargetColor))/3 
    ProcedureReturn  RGBA(grayLevel,grayLevel,grayLevel,Alpha(TargetColor))
EndProcedure

Code: Select all

Procedure SetDarkenPercent(percent)
   Global DarkFactor.f
   DarkFactor = 1 - percent / 100.0
   If DarkFactor < 0 : DarkFactor = 0 : EndIf
   If DarkFactor > 1 : DarkFactor = 1 : EndIf
EndProcedure
Procedure DarkenFilter(x, y, SourceColor, TargetColor)
   Global DarkFactor.f
   ProcedureReturn RGBA(Red(TargetColor) * DarkFactor, Green(TargetColor) * DarkFactor, Blue(TargetColor) * DarkFactor, Alpha(TargetColor))
EndProcedure

; SetDarkenPercent(10) ; make image 10% darker

Code: Select all

Procedure SetLightenPercent(percent)
   Global LightFactor.f
   LightFactor =1-percent / 100.0
   If LightFactor < 0 : LightFactor = 0 : EndIf
   If LightFactor > 1 : LightFactor = 1 : EndIf
EndProcedure
Procedure LightenFilter(x, y, SourceColor, TargetColor)
   Global LightFactor.f
   ColorToWhite = $FFFFFF - TargetColor
   ProcedureReturn RGBA(255 - Red(ColorToWhite) * LightFactor, 255 - Green(ColorToWhite) * LightFactor, 255 - Blue(ColorToWhite) * LightFactor, Alpha(TargetColor))
EndProcedure

;SetLightenPercent(20) ;make image 20% lighter
Imagewin10 x64 5.72 | IDE | PB plugin | Tools | Sprite | JSON | visual tool
User avatar
eddy
Addict
Addict
Posts: 1479
Joined: Mon May 26, 2003 3:07 pm
Location: Nantes

Post by eddy »

  • Simple Blur (not very fast) :lol:

Code: Select all

Procedure SetBlurRadius(radius)
   Global BlurRadius=radius
   Global BlurFactor.f=1 / ((radius * 2 + 1) * (radius * 2 + 1))
   
   Global Dim BlurLayer.l(OutputWidth() - 1, OutputHeight() - 1)
EndProcedure
Procedure BlurFilter(x, y, SourceColor, TargetColor)
   Global BlurRadius
   Global BlurFactor.f
   Shared BlurLayer()
   
   Protected.w r, g, b
   For yn=y - BlurRadius To y + BlurRadius
      For xn=x - BlurRadius To x + BlurRadius
         If xn<0 Or xn>=OutputWidth() Or yn<0 Or yn>=OutputHeight() ;Or (xn=x And yn=y)
            Continue
         EndIf
         
         If Not BlurLayer(xn, yn)
            BlurLayer(xn, yn)=Point(xn, yn)
         EndIf
         cn=BlurLayer(xn, yn)
         ;d=Sqr((xn-x)*(xn-x)+(yn-y)*(yn-y))
         ;k.f=BlurFactor;Cos((d/(1+BlurRadius))*0.5*#PI)
         ak.f=Alpha(cn) / 255         
         r + Red(cn) * BlurFactor * ak
         g + Green(cn) * BlurFactor * ak
         b + Blue(cn) * BlurFactor * ak
      Next
   Next
   res=RGBA(r, g, b, Alpha(TargetColor))
   
   ProcedureReturn res
EndProcedure

; SetBlurRadius(2) ; blur level = 1(normal) 2 (slow) 3 (very slow)
Imagewin10 x64 5.72 | IDE | PB plugin | Tools | Sprite | JSON | visual tool
Seymour Clufley
Addict
Addict
Posts: 1265
Joined: Wed Feb 28, 2007 9:13 am
Location: London

Post by Seymour Clufley »

Eddy, any chance of you coding an antialias filter?! ;)
JACK WEBB: "Coding in C is like sculpting a statue using only sandpaper. You can do it, but the result wouldn't be any better. So why bother? Just use the right tools and get the job done."
wilbert
PureBasic Expert
PureBasic Expert
Posts: 3942
Joined: Sun Aug 08, 2004 5:21 am
Location: Netherlands

Post by wilbert »

Code: Select all

Procedure.l Color_Interpolate(c1.l, c2.l, t.f)
  
  ; interpolate between two ARGB colors
  ; t should be a float between 0 and 1
  ; when t = 0, c1 will be returned
  ; when t = 1, c2 will be returned
  
  !fld dword [p.v_t]
  !fld1
  !fsub st0,st1
  !mov ecx,[p.v_c1]
  !mov edx,[p.v_c2]
  !mov eax,ecx
  !rol eax,8
  !and eax,$00ff00ff
  !and ecx,$00ff00ff
  !push ecx
  !push eax
  !mov eax,edx
  !rol eax,8
  !and eax,$00ff00ff
  !and edx,$00ff00ff
  !push edx
  !push eax
  !fild word [esp]
  !fmul st0,st2
  !fild word [esp + 8]
  !fmul st0,st2
  !faddp
  !fistp word [esp + 8]
  !fild word [esp + 2]
  !fmul st0,st2
  !fild word [esp + 10]
  !fmul st0,st2
  !faddp
  !fistp word [esp + 10]
  !fild word [esp + 4]
  !fmul st0,st2
  !fild word [esp + 12]
  !fmul st0,st2
  !faddp
  !fistp word [esp + 12]
  !fild word [esp + 6]
  !fmul st0,st2
  !fild word [esp + 14]
  !fmul st0,st2
  !faddp
  !fistp word [esp + 14]
  !fstp st0
  !fstp st0
  !pop eax
  !pop eax
  !pop eax
  !ror eax,8
  !pop ecx
  !or eax,ecx
  ProcedureReturn
EndProcedure

; Color interpolation filter
Procedure ColorInterpolation(x, y, SourceColor, TargetColor)
   ProcedureReturn Color_Interpolate(SourceColor, TargetColor, 0.5)
EndProcedure
User avatar
eddy
Addict
Addict
Posts: 1479
Joined: Mon May 26, 2003 3:07 pm
Location: Nantes

Re: [v4.40b2] Custom Filters() - post your useful filter here

Post by eddy »

Fat pixels on your screen :wink:

Code: Select all

Procedure PixelFilterCallback(x, y, SourceColor, TargetColor) 
   #pixelSize=5
   xn=#pixelSize*(x/#pixelSize)
   yn=#pixelSize*(y/#pixelSize)
   ProcedureReturn Point(xn,yn) 
EndProcedure 
Procedure PixelFilter() 
   CustomFilterCallback(@PixelFilterCallback()) 
EndProcedure
Imagewin10 x64 5.72 | IDE | PB plugin | Tools | Sprite | JSON | visual tool
Post Reply