Page 1 of 2

Imitation coal drawing

Posted: Thu Nov 24, 2016 10:15 am
by kvitaliy
It was
Image
and became
Image

code program:

Code: Select all

UseJPEGImageEncoder()
UseJPEGImageDecoder()
Value = 0 ; Or 1
Threshold =270       ;The threshold of sensitivity
Pattern$ = "Image |*.jpg;*.bmp"
Pattern = 0    
File$ = OpenFileRequester("Image JPG,BMP", StandardFile$, Pattern$, Pattern)
If File$
   If LoadImage(0,File$)
            
    Dim Colors(ImageWidth(0),ImageHeight(0))
            
    StartDrawing( ImageOutput(0))
       For x =  0 To ImageWidth(0) -1
           For y = 0 To ImageHeight(0)-1
              Colors(x,y) = Point(x, y)
           Next
       Next
     StopDrawing()
     CopyImage(0, 1)
    EndIf
StartDrawing( ImageOutput(1))
For x = 1 To ImageWidth(0) - 2
  For y = 1 To ImageHeight(0) - 2
       temp = Colors(x,y)
       
          Orig_blue  = Blue(temp)
          Orig_green = Green(temp)
          Orig_red   = Red(temp)
          Diff = 0
      
        For xx = x - 1 To x + 1
            For yy = y - 1 To y + 1
              If (xx <> x) Or (yy <> y)  
                 temp = Colors(xx,yy)
                 Other_blue  = Blue(temp)
                 Other_green = Green(temp)
                 Other_red   = Red(temp)
                 temp = (Orig_red - Other_red) * (Orig_red - Other_red) + (Orig_blue - Other_blue)*(Orig_blue - Other_blue)+(Orig_green - Other_green) * (Orig_green - Other_green)
                 Diff = Diff +Sqr(temp)
              EndIf
            Next yy
        Next xx
 If Value = 0  
    Diff = 255 - Diff
    If Diff < 0:   Diff = 0: EndIf
    If Diff > 255:   Diff = 255:EndIf
    Plot (x, y, RGB(Diff, Diff, Diff))

 Else
    If  Diff > Threshold
        Diff = 255 - (Diff - Threshold)
        If Diff < 0 :  Diff = 0:EndIf
        If Diff > 255 :  Diff = 255:EndIf
        Plot (x, y, RGB(Diff, Diff, Diff))
    Else
        Plot (x, y, RGB(255, 255, 255))
    EndIf
 EndIf
   Next y

 Next x
 
StopDrawing()

  If SaveImage(1,GetTemporaryDirectory() + "charcoal.jpg",#PB_ImagePlugin_JPEG)       
      RunProgram(GetTemporaryDirectory() + "charcoal.jpg")        
  EndIf
 
Else
  MessageRequester("Information", "The requester was canceled.", 0) 
EndIf

Re: Imitation coal drawing

Posted: Thu Nov 24, 2016 10:48 am
by RSBasic
Very very nice. Thank you for your code. Image

Re: Imitation coal drawing

Posted: Thu Nov 24, 2016 11:53 am
by kvitaliy
RSBasic wrote:Very very nice.
Thank you!

Re: Imitation coal drawing

Posted: Thu Nov 24, 2016 12:23 pm
by TI-994A
Truly impressive! Well done. :D

Re: Imitation coal drawing

Posted: Thu Nov 24, 2016 1:17 pm
by jack
simply amazing, and with so few lines of code. :)

Re: Imitation coal drawing

Posted: Thu Nov 24, 2016 4:16 pm
by davido
@kvitaliy,
Excellent. Thank you for sharing. :D
Surprising result with such a paucity of code!

Re: Imitation coal drawing

Posted: Thu Nov 24, 2016 6:21 pm
by kvitaliy
davido wrote: Surprising result with such a paucity of code!
Programmers Adobe Photoshop misleading the size of your product! :lol:

Re: Imitation coal drawing

Posted: Thu Nov 24, 2016 11:48 pm
by electrochrisso
8) Thanks for sharing :)

Re: Imitation coal drawing

Posted: Fri Nov 25, 2016 2:43 am
by fsw
Really cool, good job.

Reminds me of the AutoLisp program from the 90' where accurately drawn drawings done with AutoCAD would look like hand drawn.
(some lines a little bit wiggly or end of lines don't end anymore perfectly; besides other things...)

Again, good job!

Re: Imitation coal drawing

Posted: Fri Nov 25, 2016 8:47 am
by Kwai chang caine
Waoouuuh, like numerous of your works, ..very impressive :shock:
Furthermore, it's sharing.
I like your sister too, and understand why you want learn to draw :mrgreen:
Thanks a lot 8)

Re: Imitation coal drawing

Posted: Fri Nov 25, 2016 11:41 am
by Keya
kvitaliy im also a massive fan of awesome things from minimal code! one of the reasons i love PB :) can you please give us a description about the algorithm?
ps my name suggestion would be Cross-stich Charcoal Sketch :D
google images: http://www.google.com/search?q=cross+stitch&tbm=isch

Re: Imitation coal drawing

Posted: Fri Nov 25, 2016 11:45 am
by Fangbeast
Very nice Kvitaly, tried it on a favourite picture and very impressed.

Re: Imitation coal drawing

Posted: Fri Nov 25, 2016 6:35 pm
by BasicallyPure
I really like this effect.
I have modified your code to a procedure version.
I tried to optimize for speed but haven't done any real comparisons.
I combined the two variables 'value' and 'threshold' to one variable.
For maximum sensitivity just use threshold = 0.
I removed the creation of a second image in memory, I don't think it's really necessary.
I know my version of the code looks a lot different but I believe it produces the same result,
and hopefully runs a little faster.
I noticed one problem with your code.
There is a one pixel border around the image that is not converted.
I included a simple workaround that draws a white one pixel border which looks good on
most images I have tested.
Thanks a lot for posting your code.

edit: improved speed
edit: improved user interface
edit: improved speed
edit: added solution for 1 pixel border problem
improved demo user interface - now with threshold control, clipboard copy/paste functions.

Code: Select all

; charcoal image effect
; posted by kvitaliy
; forum link: http://www.purebasic.fr/english/viewtopic.php?f=12&t=67022&sid
; this modified version by BasicallyPure 11/27/2016

EnableExplicit

UseJPEGImageDecoder() : UsePNGImageDecoder()

Procedure CharcoalEffect(image.i, threshold.i = 50)
   ; apply charcoal drawing effect to image
   ; threshold sets sensitivity, 0 = maximum
   
   Protected.i  x, y, xx, yy, r, g, b, c, Xmax, Ymax, diff
   Protected.i result = #False
   Protected.a rr, gg, bb
   
   Macro Tally()
      c = pixels(xx,yy)
      r = rr - c & $FF : c >> 8
      g = gg - c & $FF : c >> 8
      b = bb - c & $FF
      diff + Sqr(r*r + g*g + b*b)
   EndMacro
   
   If IsImage(image)
      Xmax = ImageWidth(image)  - 1
      Ymax = ImageHeight(image) - 1
      
      Dim pixels(Xmax,Ymax)
      
      If StartDrawing(ImageOutput(image))
         For x =  0 To Xmax
            For y = 0 To Ymax
               pixels(x,y) = Point(x,y)
            Next
         Next
            
         Xmax -1 : Ymax -1
         
         For x = 1 To Xmax
            For y = 1 To Ymax
               
               c = pixels(x,y)
               rr = c & $FF : c >> 8
               gg = c & $FF : c >> 8
               bb = c & $FF
               xx = x - 1
               yy = y
               diff = 0
               
               ; examine adjacent pixels
               Tally() : yy-1 : Tally() : xx+1 : Tally() : xx+1 : Tally() : yy+1
               Tally() : yy+1 : Tally() : xx-1 : Tally() : xx-1 : Tally()
               ;
               
               If diff > Threshold
                  diff = Threshold - diff + 255
                  If diff < 0 : diff = 0 : EndIf
               Else
                  diff = 255
               EndIf
               
               Plot(x, y, diff<<16 | diff<<8 | diff)
               
            Next y
         Next x
         
         ;do the border
         Xmax + 1 : Ymax + 1
         For x = 0 To Xmax : Plot(x,0,Point(x,1)) : Plot(x,Ymax,Point(x,Ymax-1)) : Next x
         For y = 0 To Ymax : Plot(0,y,Point(1,y)) : Plot(Xmax,y,Point(Xmax-1,y)) : Next y
         ;
         
         StopDrawing()
         
         FreeArray(pixels())
         result = #True
      EndIf
   EndIf
   
   ProcedureReturn result
EndProcedure

; ________________________________________________________________________________


Define File$, Pattern$ = "*.jpg|*.jpg|*.png|*.png|*.bmp|*.bmp|*.jpg, *.png, *.bmp|*.jpg;*.png;*.bmp"
Define.i invisible, conversionTime, quit = #False, Pattern = 3
Define  threshold = 50 ;default value

CompilerIf #PB_Compiler_OS = #PB_OS_Linux
   File$ = GetHomeDirectory() + "Pictures/"
CompilerEndIf

If Not OpenWindow(0,0,0,1,1,"",#PB_Window_BorderLess|#PB_Window_Invisible) : End : EndIf
   invisible = #True
   ImageGadget(0,0,0,1,1,0)

If OpenWindow(1,0,0,225,160,"Charcoal effect",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
   
   StringGadget(1,0,0,225,30,"",#PB_String_ReadOnly)
   ButtonGadget(2,005,35,60,30,"Load")  : GadgetToolTip(2,"Load an image from disk")
   ButtonGadget(3,130,125,70,30,"Exit")
   ButtonGadget(4,80,35,60,30,"Copy")   : GadgetToolTip(4,"copy image to clipboard")
   ButtonGadget(5,155,35,60,30,"Paste") : GadgetToolTip(5,"paste image from clipboard")
   ButtonGadget(6,30,125,70,30,"Apply") : GadgetToolTip(6,"apply the charcoal effect")
   FrameGadget(7,5,70,215,50,"Threshold = "+Str(threshold))
   TrackBarGadget(8,8,85,205,30,0,500)
   SetGadgetState(8,threshold) ;default threshold
   
   Repeat
      Select WaitWindowEvent()
         Case #PB_Event_CloseWindow : End
         Case #PB_Event_Gadget
            Select EventGadget()
               Case 0 : If EventType() = #PB_EventType_LeftClick : SetActiveWindow(1) : EndIf
               
               Case 2 : ; Load
                  File$ = OpenFileRequester("Select an image", File$, Pattern$, Pattern)
                  If File$
                     Pattern = SelectedFilePattern()
                     If LoadImage(0, File$)
                        If invisible : HideWindow(0,0) : SetActiveWindow(1) : invisible = #False : EndIf
                        ResizeWindow(0,0,0,ImageWidth(0),ImageHeight(0))
                        SetGadgetState(0,ImageID(0))
                        CopyImage(0,1)
                        SetGadgetText(1,"Image loaded from disk.")
                     EndIf
                  Else
                     SetGadgetText(1,"No image was loaded.")
                  EndIf
               Case 3 : quit = #True ; Exit
               Case 4  ; Copy
                  If IsImage(1)
                     SetClipboardImage(1)
                     SetGadgetText(1,"Image copied to clipboard.")
                  Else : SetGadgetText(1,"Error!  no image available")
                  EndIf
               Case 5 ;Paste
                  If GetClipboardImage(1)
                     CopyImage(1,0)
                     If invisible : HideWindow(0,0) : SetActiveWindow(1) : invisible = #False : EndIf
                     ResizeWindow(0,0,0,ImageWidth(0),ImageHeight(0))
                     SetGadgetState(0,ImageID(0))
                     SetGadgetText(1,"Image pasted from clipboard.")
                  Else : SetGadgetText(1,"Error!  No image in clipboard.")
                  EndIf
               Case 6 ; Apply
                  CopyImage(0,1)
                  threshold = GetGadgetState(8)
                  conversionTime = ElapsedMilliseconds()
                  If CharcoalEffect(1, threshold)
                     conversionTime = ElapsedMilliseconds() - conversionTime
                     SetGadgetState(0,ImageID(1))
                     SetGadgetText(1,"Conversion time = " + Str(conversionTime)+" mS.")
                  Else
                     SetGadgetText(1,"Error!  No image loaded.")
                  EndIf
               Case 8 ; Threshold
                  SetGadgetText(7,"Threshold = "+Str(GetGadgetState(8)))
            EndSelect
      EndSelect
   Until quit
EndIf

Re: Imitation coal drawing

Posted: Sat Nov 26, 2016 5:00 am
by kvitaliy
BasicallyPure wrote:I really like this effect.
Thank you for improving the code!
It looks like the code faster with the included debug
My code is faster if both code without debug!

Re: Imitation coal drawing

Posted: Sat Nov 26, 2016 12:49 pm
by AAT
Hi, kvitaliy
Thanks for nice code!

I have another version of the converted picture :)
Image

The example is cv_enhance_edges.pb in the JHPJHP's OpenCV pack http://www.purebasic.fr/english/viewtop ... 40&t=57457