filtre emboss

Programmation d'applications complexes
manababel
Messages : 135
Inscription : jeu. 14/mai/2020 7:40

filtre emboss

Message par manababel »

Vous pouvez trouver un programme similaire a l'adresse :
https://www.purebasic.fr/english/viewto ... 12&t=76619

Activez le multi-thread. (dans : compilateur / options du compilateur...)

le programme devrait tourner en 32Bits et 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 -1
If ndt < 1 : ndt = 1 :EndIf

Global Dim Thread(ndt_max+1)
Structure var
  source.i
  cible.i
  start.i
  stop.i
  power.i
  orientation.i
  light.i
EndStructure
Global ndb
Global Dim param.var((ndt_max)*2+1)



; partie du programme à modifier pour adapter se programme au votre
; convertie les "IDs" des images en pointer d'adresse
; test si les images sont en 32bits et de la meme taille
;-------------------------------------------------------------------

Macro sp(source,cible)
  Protected Depth.i , lg.q , ht.i , lg1.i , ht1.i , taille.i
  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()
  ndb = 4
  If depth<>32 : ndb=3 : EndIf
  
  If lg<>lg1 Or ht<>ht1 : ProcedureReturn : EndIf
  
  taille = lg * ht
EndMacro

Macro clampRGB(r,g,b)
  If r<0:r=0:EndIf
  If g<0:g=0:EndIf
  If b<0:b=0:EndIf
  If r>255:r=255:EndIf
  If g>255:g=255:EndIf
  If b>255:b=255:EndIf
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 emboss_sp(i)
  
  Protected source , cible , start , stop , power , orientation , light
  Protected x , y, px, py , dx , dy , pos1 , pos2
  Protected rgb , r ,g , b , r1 , g1 , b1 , r2 , g2 , b2
  
  source=param(i)\source
  cible=param(i)\cible
  start=param(i)\start
  stop=param(i)\stop
  power=param(i)\power
  orientation=param(i)\orientation
  light=param(i)\light
  
  sp(source,cible)
  
  If power < 1 : power = 1 : EndIf
  If stop > (ht-1) : stop= ht-1 : EndIf
  
  Select orientation
    Case 0
      dx = 0 : dy = 1
    Case 1
      dx = 1 : dy = 1
    Case 2
      dx = 1 : dy = 0
    Case 3
      dx = 1 : dy = -1
    Case 4
      dx = 0 : dy = -1
    Case 5
      dx = -1 : dy = -1
    Case 6
      dx = -1 : dy = 0
    Case 7
      dx = -1 : dy = 1
  EndSelect
  
    For y=start To stop
      For x=0 To lg-1
        px = x + dx
        py = y + dy
        clamp( px , 0 , lg-1 )
        clamp( py , 0 , ht-1 )
        pos1 = ((y*lg)+x) * ndb
        pos2 = ((py*lg)+px) * ndb
        rgb = PeekL(source_p + pos1 )
        Returnrgb( rgb , r1 , g1 , b1 )
        rgb = PeekL(source_p + pos2 )
        Returnrgb( rgb , r2 , g2 , b2 )
        
        ; version couleur
        r = light + (r2 - r1) * power
        g = light + (g2 - g1) * power
        b = light + (b2 - b1) * power
        clamprgb(r,g,b)
        PokeL(cible_p+((y*lg+x)<<2), r<<16 + g<<8 + b)
        
        ; version noir & blanc (gris)
        ;g1 = ((r1 + g1 + b1)*85) >> 8 ; = (r+g+b)/3
        ;g2 = ((r2 + g2 + b2)*85) >>8
        ;g = light + (g2 - g1) * power
        ;clamp(g , 0 , 255)
        ;PokeL(cible_p+((y*lg+x)<<2), g * $10101)
        
      Next
    Next  
    
EndProcedure

;-------------------------------------------------------------------
Procedure emboss(source.i,cible.i,power.i,orientation.i,light.i=128)
  
  Protected div.i , i.i , var.i
  
  sp(source,cible)
  
  div=ht/ndt
 
  For i=0 To ndt-1
    Param(i)\source=source
    Param(i)\cible=cible
    Param(i)\power=power
    Param(i)\orientation=orientation
    Param(i)\light=light
    Param(i)\start=i*div
    var = (i*div)+div-1
    If i = (ndt-1) And var < ht : var = ht-1 : EndIf
    Param(i)\stop=var
    Thread(i)=CreateThread(@emboss_sp(),i)
  Next
  
  For i=0 To ndt-1
    If Thread(i) : WaitThread(thread(i)):EndIf
  Next
  
EndProcedure


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


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


If OpenWindow(0, 0, 0, imgx, imgy+40, "Emboss", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  Define source.i , cible.i , t.i , file$ , i , quit.i
  
  ScrollBarGadget(100, 50, 0, 250, 18, 1, 25, 1) ; power
  ScrollBarGadget(101, 400, 0, 250, 18, 0, 7, 1) ; orientation
  ScrollBarGadget(102, 750, 0, 250, 18, 0, 255, 1) ; light 
  SetGadgetState(102, 128)
  
  TextGadget(110, 50, 20, 250, 18, "Power" , #PB_Text_Center)
  TextGadget(111, 400, 20, 250, 18, "Orientation" , #PB_Text_Center)
  TextGadget(112, 750, 20, 250, 18, "Light" , #PB_Text_Center)
  
  file$ = OpenFileRequester("Image","","",0)
  
  source=10
  cible=20
  
  If Not LoadImage(source,file$) ; <- commande differente de "LOADIMAGE"
    MessageRequester("load_image","erreur de chargement",#PB_MessageRequester_Ok | #PB_MessageRequester_Error)
    End
  EndIf
  
   
   ResizeImage(source,imgx,imgy,#PB_Image_Smooth)
   
   CreateImage(cible,imgx,imgy,32) ; l'image doit entre en mode 32bits
   
  emboss(source,cible,GetGadgetState(100),GetGadgetState(101))
  Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Quit = 1
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 100 , 101 , 102
          t=ElapsedMilliseconds()
          emboss(source,cible,GetGadgetState(100),GetGadgetState(101),GetGadgetState(102))
          t=ElapsedMilliseconds()-t
      EndSelect
  EndSelect 

  StartDrawing(WindowOutput(0))
  DrawImage(ImageID(cible),0,40)
  ;DrawText(5,2,Str(t)+"   ")
  StopDrawing()
  
Until Quit = 1

EndIf