PureBasic

Forums PureBasic - Français
http://forums.purebasic.com/french/

filtre OilPainting

http://forums.purebasic.com/french/viewtopic.php?t=18271

Page 1 sur 1

filtre OilPainting

Publié : mar. 02/févr./2021 14:55
par manababel
Bonjour
Voici une version du filtre "OilPainting" optimisé .

cette méthode demande beaucoup de ressources au processeur .

Désactivez le debugger et activez le multi-thread. (dans : compilateur / options du compilateur...)

Version 64Bits

Code : Tout sélectionner

EnableExplicit

CompilerIf #PB_Compiler_Thread = #False
   CompilerError "Enable Thread Safe mode!"
CompilerEndIf

Global ndt_max=CountCPUs(#PB_System_ProcessCPUs )
Global ndt=ndt_max
If ndt < 1 : ndt = 1 :EndIf

Global Dim Thread(ndt_max+1)
Structure var
  source.i
  cible.i
  start.l
  stop.l
  radius.l
  intensity.l
EndStructure
Global Dim param.var((ndt_max)*2+1)

Global Dim nr.l(256 + ndt_max * 256)
Global Dim ng.l(256 + ndt_max * 256)
Global Dim nb.l(256 + ndt_max * 256)
Global Dim it.l(256 + ndt_max * 256)

; charge une image et la convertie en 32bit
;-------------------------------------------------------------------
Procedure load_image(nom,file$)
  Protected source_p.i , cible_p.i , s.i
  Protected lg.l , ht.l , taille.l , depth.l
 
  LoadImage(nom,file$)
  If Not IsImage(nom) : ProcedureReturn 0 : EndIf
   
  StartDrawing(ImageOutput(nom))
  source_p = DrawingBuffer()
  ht = ImageHeight(nom)
  lg = ImageWidth(nom)
  Depth=OutputDepth()
  StopDrawing()
 
  If Depth=24
    taille=lg*ht
    cible_p=AllocateMemory(taille*4)
    Dim save.q(4)
    s=@save()
    EnableASM
      !mov rax,[p.v_s]
      !mov [rax],rcx
      !mov [rax+8],rdx
      !mov [rax+16],r8
      !mov rcx,[p.v_source_p]
      !mov rdx,[p.v_cible_p]
      !mov r8,[p.v_taille]
      !sub r8,1 ; <---------------- ????
      !copy_boucle24:
        !mov eax,[rcx]     
        !mov [rdx],eax
        !add rcx,3
        !add rdx,4
        !dec r8
       !jnz copy_boucle24
      !mov rax,[p.v_s]
      !mov rcx,[rax]
      !mov rdx, [rax+8]
      !mov r8,[rax+16]
    DisableASM
    FreeArray(save())
   
    FreeImage(nom) ; supprime l'image 24bits
    CreateImage(nom,lg,ht,32)
    StartDrawing(ImageOutput(nom))
    source_p = DrawingBuffer()
    StopDrawing()
    CopyMemory( cible_p , source_p , taille*4 )
    FreeMemory(cible_p)
  EndIf
 
  ProcedureReturn 1
EndProcedure

;-------------------------------------------------------------------

Macro sp(source,cible)
  Protected Depth.l , lg.l , ht.l , lg1.l , ht1.l , taille.l
  Protected cible_p.i , source_p.i
 
  StartDrawing(ImageOutput(cible))
  cible_p = DrawingBuffer()
  ht1 = ImageHeight(cible)
  lg1 = ImageWidth(cible)
  Depth=OutputDepth()
  StopDrawing()
  If depth<>32 : ProcedureReturn : EndIf
 
  StartDrawing(ImageOutput(source))
  source_p = DrawingBuffer()
  ht = ImageHeight(source)
  lg = ImageWidth(source)
  Depth=OutputDepth()
  StopDrawing()
  If depth<>32 : ProcedureReturn : EndIf
 
  If lg<>lg1 Or ht<>ht1 : ProcedureReturn : EndIf
 
  taille = lg * ht
EndMacro

Macro returnRGB(pixel,r,g,b)
    r=(pixel & $ff0000)>>16
    g=(pixel & $ff00)>>8
    b=(pixel & $ff)
EndMacro

Macro clamp(var,min,max)
  If var<min : var = min : EndIf
  If var>max : var = max : EndIf
EndMacro

;-------------------------------------------------------------------

Procedure OilPainting_sp(i)
  
  Protected i2.l = i*256
  Protected source.i , cible.i , start.l , stop.l , radius.l , intensity.l
  Protected x.l,y.l , xx.l,yy.l , px.l,py.l , j.l , rgb.l , r.l , g.l , b.l , index.l
  
  source=param(i)\source
  cible=param(i)\cible
  start=param(i)\start
  stop=param(i)\stop
  radius=param(i)\radius
  intensity=param(i)\intensity

  sp(source,cible)
  
  If stop > (ht-1) : stop= ht-1 : EndIf
 
  For y=start To stop
    For j=0 To intensity : nr(j+i2)=0 : ng(j+i2)=0 : nb(j+i2)=0 : it(j+i2)=0 : Next
   
    For yy=-radius To radius
    For xx=-radius To radius
      px=xx
      py=yy+y
      clamp(px,0,lg-1)
      clamp(py,0,ht-1)
      rgb = PeekL(source_p+((py*lg+px)<<2)) 
      ReturnRGB( rgb , r , g , b )
      index = (rgb >> 24) & 255
      it(index+i2) = it(index+i2) + 1
      nr(index+i2) = nr(index+i2) + r
      ng(index+i2) = ng(index+i2) + g
      nb(index+i2) = nb(index+i2) + b
    Next
    Next
 
    For x=0 To lg-1       
      For yy=-radius To radius    
        px=x-radius
        py=yy+y
        clamp(px,0,lg-1)
        clamp(py,0,ht-1)
        rgb = PeekL(source_p+((py*lg+px)<<2))
        ReturnRGB( rgb , r , g , b )
        index = (rgb >> 24) & 255   
        it(index+i2) = it(index+i2) - 1
        nr(index+i2) = nr(index+i2) - r
        ng(index+i2) = ng(index+i2) - g
        nb(index+i2) = nb(index+i2) - b
       
        px=x+radius+1
        py=yy+y
        clamp(px,0,lg-1)
        clamp(py,0,ht-1)
        rgb = PeekL(source_p+((py*lg+px)<<2))
        ReturnRGB( rgb , r , g , b )
        index = (rgb >> 24) & 255
        it(index+i2) = (it(index+i2) + 1)
        nr(index+i2) = (nr(index+i2) + r)
        ng(index+i2) = (ng(index+i2) + g)
        nb(index+i2) = (nb(index+i2) + b)
       
      Next
          r=0:g=0:b=0
          For j=0 To intensity
            If it(j+i2)>it(r+i2):r=j:EndIf
            If it(j+i2)>it(g+i2):g=j:EndIf
            If it(j+i2)>it(b+i2):b=j:EndIf
          Next
          
          If it(r+i2)>0 : r=nr(r+i2)/(it(r+i2)) : EndIf
          If it(g+i2)>0 : g=ng(g+i2)/(it(g+i2)) : EndIf
          If it(b+i2)>0 : b=nb(b+i2)/(it(b+i2)) : EndIf
          PokeL(cible_p+((y*lg+x)<<2),(r<<16+g<<8+b))
    Next     
  Next
         
EndProcedure

;-------------------------------------------------------------------
Procedure OilPainting(source.i,cible.i,radius.l,intensity.l)
 
  Protected div.l , i.l , x.l , y.l
  Protected rgb.l , a.l , r.l , g.l , b.l
  
  sp(source,cible)
 
  For y=0 To ht-1
    For x=0 To lg-1
      rgb = PeekL(source_p+((y*lg+x)<<2))
      Returnrgb( rgb , r , g , b )
      a = (( r + g + b ) * 85)>>8
      a = (( a * intensity )>>8) & 255
      PokeL(source_p+((y*lg+x)<<2),( a<<24 + r<<16 + g<<8 + b ))
    Next
  Next
 
  div=ht/ndt

  For i=0 To ndt-1
    Param(i)\source=source
    Param(i)\cible=cible
    Param(i)\radius=radius
    Param(i)\intensity=intensity
    Param(i)\start=i*div
    Param(i)\stop=(i*div)+div-1
    Thread(i)=CreateThread(@OilPainting_sp(),i)
  Next
 
  For i=0 To ndt-1
    If Thread(i) : WaitThread(thread(i)):EndIf
  Next
 
EndProcedure
;-------------------------------------------------------------------

UseJPEGImageDecoder()
UsePNGImageDecoder()
Global imgx=800
Global imgy=600

If OpenWindow(0, 0, 0, imgx, imgy, "OilPainting", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  Define source.i=0 , cible.i=0 , t.i , file$ , nom$ , quit.l
 
  CreateMenu(0, WindowID(0))
    MenuTitle("Load")
      MenuItem( 1, "Load")
   MenuTitle("Save")   
    MenuItem( 2, "Save BMP")
    ;MenuItem( 3, "Save JPG")
    MenuItem( 4, "Save Clipboard")
  MenuTitle("Quit")
    MenuItem( 5, "Quit")
   
  ScrollBarGadget(100, 50, 0, 250, 18, 0, 10, 1)
  ScrollBarGadget(101, 400, 0, 250, 18, 0, 255, 1)
   
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        Quit = 1
       
      Case #PB_Event_Gadget
        Select EventGadget() 
          Case 100 , 101
            t=ElapsedMilliseconds()
            OilPainting(source,cible,GetGadgetState(100),GetGadgetState(101))
            t=ElapsedMilliseconds()-t
        EndSelect
       
      Case #PB_Event_Menu
        Select EventMenu()
          Case 1 
            If source = 0
              source = 10
            Else
              FreeImage((source))
              FreeImage((cible))
              cible = 0
            EndIf
            file$ = OpenFileRequester("Image","","",0)
            If Not Load_Image(source,file$)
              MessageRequester("load_image","erreur de chargement",#PB_MessageRequester_Ok | #PB_MessageRequester_Error)
            Else
              If cible = 0 And source = 10 
                cible = 20
                CopyImage(source,cible)
              EndIf
              
              OilPainting(source,cible,GetGadgetState(100),GetGadgetState(101))
            EndIf
           
          Case 2
            nom$ = SaveFileRequester("Save BMP", "", "", 0)
            If nom$ <> "" : SaveImage(cible, nom$+".bmp" ,#PB_ImagePlugin_BMP ) : EndIf
          Case 3
            ;SaveFileRequester("Save JPG", "", "", 0)
            ;If nom$ <> "" : SaveImage(cible, nom$+".jpg" ,#PB_ImagePlugin_JPEG ,10 ) : EndIf
          Case 4
            SetClipboardImage(cible)
          Case 5
            quit = 1
        EndSelect     
    EndSelect
   
Debug cible
    StartDrawing(WindowOutput(0))
    If cible<>0
      DrawImage(ImageID(cible),0,20)
    EndIf
    DrawText(5,2,Str(t)+"   ")
    StopDrawing()
   
  Until Quit = 1
 
EndIf





Version 32bits ( à tester , fonctionne sur une version 64bits )

Code : Tout sélectionner

EnableExplicit

CompilerIf #PB_Compiler_Thread = #False
   CompilerError "Enable Thread Safe mode!"
CompilerEndIf

UseJPEGImageDecoder()
UsePNGImageDecoder()
Global imgx=800
Global imgy=600
Global ndc
Global Dim mem(imgx,imgy)

Global ndt_max=CountCPUs(#PB_System_ProcessCPUs )
Global ndt=ndt_max
If ndt < 1 : ndt = 1 :EndIf

Global Dim Thread(ndt_max+1)
Structure var
  source.i
  cible.i
  start.l
  stop.l
  radius.l
  intensity.l
EndStructure
Global Dim param.var((ndt_max)*2+1)

Global Dim nr.l(256 + ndt_max * 256)
Global Dim ng.l(256 + ndt_max * 256)
Global Dim nb.l(256 + ndt_max * 256)
Global Dim it.l(256 + ndt_max * 256)

;-------------------------------------------------------------------

Macro sp(source,cible)
  Protected Depth , lg , ht , lg1 , ht1 , taille
  Protected cible_p , source_p

  StartDrawing(ImageOutput(cible))
  cible_p = DrawingBuffer()
  ht1 = ImageHeight(cible)
  lg1 = ImageWidth(cible)
  StopDrawing()

  StartDrawing(ImageOutput(source))
  source_p = DrawingBuffer()
  ht = ImageHeight(source)
  lg = ImageWidth(source)
  depth = ImageDepth(source)
  ndc = 3
  If depth = 32 : ndc = 4 : EndIf
  Debug depth
  StopDrawing()

  If lg<>lg1 Or ht<>ht1 : ProcedureReturn : EndIf
  taille = lg * ht
EndMacro

Macro returnRGB(pixel,r,g,b)
    r=(pixel & $ff0000)>>16
    g=(pixel & $ff00)>>8
    b=(pixel & $ff)
EndMacro

Macro clamp(var,min,max)
  If var<min : var = min : EndIf
  If var>max : var = max : EndIf
EndMacro

;-------------------------------------------------------------------

Procedure OilPainting_sp(i)
  
  Protected i2.l = i*256
  Protected source.i , cible.i , start.l , stop.l , radius.l , intensity.l , pos.i
  Protected x.l,y.l , xx.l,yy.l , px.l,py.l , j.l , rgb.l , r.l , g.l , b.l , index.l
  
  source=param(i)\source
  cible=param(i)\cible
  start=param(i)\start
  stop=param(i)\stop
  radius=param(i)\radius
  intensity=param(i)\intensity

  sp(source,cible)
  
  If stop > (ht-1) : stop= ht-1 : EndIf
 
  For y=start To stop
    For j=0 To intensity : nr(j+i2)=0 : ng(j+i2)=0 : nb(j+i2)=0 : it(j+i2)=0 : Next
   
    For yy=-radius To radius
    For xx=-radius To radius
      px=xx
      py=yy+y
      clamp(px,0,lg-1)
      clamp(py,0,ht-1)
        If ndc=3
          pos = source_p+((py*lg+px)*ndc)
          r = PeekA(pos + 0)
          g = PeekA(pos + 1)
          b = PeekA(pos + 2)
        Else
          rgb = PeekL(source_p+((py*lg+px)<<2))
          ReturnRGB( rgb , r , g , b )
        EndIf
      index = mem(px,py)
      it(index+i2) = it(index+i2) + 1
      nr(index+i2) = nr(index+i2) + r
      ng(index+i2) = ng(index+i2) + g
      nb(index+i2) = nb(index+i2) + b
    Next
    Next
 
    For x=0 To lg-1       
      For yy=-radius To radius    
        px=x-radius
        py=yy+y
        clamp(px,0,lg-1)
        clamp(py,0,ht-1)
        If ndc=3
          pos = source_p+((py*lg+px)*ndc)
          r = PeekA(pos + 0)
          g = PeekA(pos + 1)
          b = PeekA(pos + 2)
        Else
          rgb = PeekL(source_p+((py*lg+px)<<2))
          ReturnRGB( rgb , r , g , b )
        EndIf
        index = mem(px,py)  
        it(index+i2) = it(index+i2) - 1
        nr(index+i2) = nr(index+i2) - r
        ng(index+i2) = ng(index+i2) - g
        nb(index+i2) = nb(index+i2) - b
       
        px=x+radius+1
        py=yy+y
        clamp(px,0,lg-1)
        clamp(py,0,ht-1)
        If ndc=3
          pos = source_p+((py*lg+px)*ndc)
          r = PeekA(pos + 0)
          g = PeekA(pos + 1)
          b = PeekA(pos + 2)
        Else
          rgb = PeekL(source_p+((py*lg+px)<<2))
          ReturnRGB( rgb , r , g , b )
        EndIf
        index = mem(px,py)
        it(index+i2) = (it(index+i2) + 1)
        nr(index+i2) = (nr(index+i2) + r)
        ng(index+i2) = (ng(index+i2) + g)
        nb(index+i2) = (nb(index+i2) + b)
       
      Next
          r=0:g=0:b=0
          For j=0 To intensity
            If it(j+i2)>it(r+i2):r=j:EndIf
            If it(j+i2)>it(g+i2):g=j:EndIf
            If it(j+i2)>it(b+i2):b=j:EndIf
          Next
          
          If it(r+i2)>0 : r=nr(r+i2)/(it(r+i2)) : EndIf
          If it(g+i2)>0 : g=ng(g+i2)/(it(g+i2)) : EndIf
          If it(b+i2)>0 : b=nb(b+i2)/(it(b+i2)) : EndIf
          If ndc=3
            PokeA(cible_p+((y*lg+x)*ndc+0),r)
            PokeA(cible_p+((y*lg+x)*ndc+1),g)
            PokeA(cible_p+((y*lg+x)*ndc+2),b)
          Else
            PokeL(cible_p+((y*lg+x)<<2),r<<16 + g<<8 + b)
          EndIf
          
    Next     
  Next
         
EndProcedure
          ;  nCurMax = 0;
          ;  nMaxIndex = 0;
          ;  For nI = 0 to 255
          ;      If( nIntensityCount[nI] > nCurMax ){
          ;          nCurMax = nIntensityCount[nI];
          ;          nMaxIndex = nI;
          ;      }
          ;  }
          ;  r = nSumR[nMaxIndex] / nCurMax;
          ;  g = nSumG[nMaxIndex] / nCurMax;
          ;  b = nSumB[nMaxIndex] / nCurMax;
;-------------------------------------------------------------------
Procedure OilPainting(source.i,cible.i,radius.l,intensity.l)
 
  Protected div.l , i.l , x.l , y.l
  Protected rgb.l , a.l , r.l , g.l , b.l
  
  sp(source,cible)
 
  For y=0 To ht-1
    For x=0 To lg-1
      rgb = PeekL(source_p+((y*lg+x)*ndc))
      Returnrgb( rgb , r , g , b )
      a = (( r + g + b ) * 85)>>8
      a = (( a * intensity )>>8) & 255
      mem(x,y) = a
    Next
  Next
 
  div=ht/ndt

  For i=0 To ndt-1
    Param(i)\source=source
    Param(i)\cible=cible
    Param(i)\radius=radius
    Param(i)\intensity=intensity
    Param(i)\start=i*div
    Param(i)\stop=(i*div)+div-1
    Thread(i)=CreateThread(@OilPainting_sp(),i)
  Next
 
  For i=0 To ndt-1
    If Thread(i) : WaitThread(thread(i)):EndIf
  Next
 
EndProcedure

;-------------------------------------------------------------------

UseJPEGImageDecoder()
UsePNGImageDecoder()
Global imgx=800
Global imgy=600

If OpenWindow(0, 0, 0, imgx, imgy, "OilPainting", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  Define source.i=0 , cible.i=0 , t.i , file$ , nom$ , quit.l
  Define ht1.l , lg1.l
  
  CreateMenu(0, WindowID(0))
    MenuTitle("Load")
      MenuItem( 1, "Load")
   MenuTitle("Save")   
    MenuItem( 2, "Save BMP")
    ;MenuItem( 3, "Save JPG")
    MenuItem( 4, "Save Clipboard")
  MenuTitle("Quit")
    MenuItem( 5, "Quit")
   
  ScrollBarGadget(100, 50, 0, 250, 18, 0, 10, 1)
  ScrollBarGadget(101, 400, 0, 250, 18, 0, 255, 1)
   
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        Quit = 1
       
      Case #PB_Event_Gadget
        Select EventGadget() 
          Case 100 , 101
            t=ElapsedMilliseconds()
            OilPainting(source,cible,GetGadgetState(100),GetGadgetState(101))
            t=ElapsedMilliseconds()-t
        EndSelect
       
      Case #PB_Event_Menu
        Select EventMenu()
          Case 1 
            If source = 0
              source = 10
            Else
              FreeImage((source))
              FreeImage((cible))
              cible = 0
            EndIf
            file$ = OpenFileRequester("Image","","",0)
            If Not LoadImage(source,file$)
              MessageRequester("load_image","erreur de chargement",#PB_MessageRequester_Ok | #PB_MessageRequester_Error)
            Else
              If cible = 0 And source = 10 
                cible = 20
                CopyImage(source,cible)
                StartDrawing(ImageOutput(source))
                ht1 = ImageHeight(source)
                lg1 = ImageWidth(source)
                FreeArray(mem())
                Dim mem(lg1,ht1)
                StopDrawing()
              EndIf
              
              OilPainting(source,cible,GetGadgetState(100),GetGadgetState(101))
            EndIf
           
          Case 2
            nom$ = SaveFileRequester("Save BMP", "", "", 0)
            If nom$ <> "" : SaveImage(cible, nom$+".bmp" ,#PB_ImagePlugin_BMP ) : EndIf
          Case 3
            ;SaveFileRequester("Save JPG", "", "", 0)
            ;If nom$ <> "" : SaveImage(cible, nom$+".jpg" ,#PB_ImagePlugin_JPEG ,10 ) : EndIf
          Case 4
            SetClipboardImage(cible)
          Case 5
            quit = 1
        EndSelect     
    EndSelect
   
    StartDrawing(WindowOutput(0))
    If cible<>0
      DrawImage(ImageID(cible),0,20)
    EndIf
    DrawText(5,2,Str(t)+"   ")
    StopDrawing()
   
  Until Quit = 1
 
EndIf

Re: filtre OilPainting

Publié : mar. 02/févr./2021 15:28
par falsam
Merci beaucoup c'est magnifique. J'ai fait un test sur une image de 6 Mo de pixels.

Cliquez sur le lien pour voir le résultat.
http://www.falsam.com/Download/purebasic/oildemo.gif

Re: filtre OilPainting

Publié : mar. 02/févr./2021 17:00
par Kwai chang caine
Merci Manababel 8)
Mais je suppose que c'est du X64 :|

Merci aussi FALSAM grâce aussi à toi, j'ai pu voir cette merveille 8O

Re: filtre OilPainting

Publié : mar. 02/févr./2021 17:56
par manababel
Ajoute d'une version qui devrait fonctionner en 32 bits

Re: filtre OilPainting

Publié : mar. 02/févr./2021 22:28
par venom
Bravo manababel, belle performance. 8)
Fonctionne en 64 et 32 bits :wink:






@++

Re: filtre OilPainting

Publié : mer. 03/févr./2021 17:52
par Kwai chang caine
Ajoute d'une version qui devrait fonctionner en 32 bits
Excuse moi, de t'avoir donné du travail en plus :oops:
Ca marche niquel
Milles mercis de ton talent, ta gentillesse et de ton partage 8)

Re: filtre OilPainting

Publié : mer. 03/févr./2021 18:16
par SPH
Kwai chang caine a écrit :Milles mercis de ton talent, ta gentillesse et de ton partage 8)
Tout pareil 8)

Re: filtre OilPainting

Publié : lun. 08/févr./2021 22:42
par Guillot
impeccable
fait plaisir de voir tes codes
faut que tu nous compile tout tes filtres dans une fonction (ou plusieurs)
et que tu les propose à l'équipe de PB
je pense que ça serait utile à beaucoup

Re: filtre OilPainting

Publié : lun. 08/févr./2021 23:33
par kernadec
bsr manababel
comme d'habitude tu nous permet de devenir des artistes 8O
Merci pour le partage
peut être ajouter à la ligne 312 une copie vers le presse-papier
et ensuite coller et sauver avec Paint
cordialement

Code : Tout sélectionner

 SetClipboardImage(cible)

Re: filtre OilPainting

Publié : mar. 09/févr./2021 20:29
par manababel
Ajout de "save image" sur la version compatible 32 bits.
n'hésitez pas à modifier mes programmes .
( et correction d'un bug sur les images 32 bits )

Re: filtre OilPainting

Publié : mar. 16/févr./2021 21:07
par manababel
Je viens de modifier le programme , il est 2x plus rapide que la version précédente.
Les tableaux à plusieurs dimensions on l'aire d'etres tres lent en Pb .
j'ai juste changé les "dim xx(a,b)" en "dim xx(a+b*256)
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru