Image to ASCII

Developed or developing a new product in PureBasic? Tell the world about it.
Konne
Enthusiast
Enthusiast
Posts: 434
Joined: Thu May 12, 2005 9:15 pm

Image to ASCII

Post by Konne »

This cool program produces ASCII aout of an Image (ASCII-Art), and its also possible to transform Images with Text (Lucida Console,10,Standart) in the left top corner of the image into a Textfile.

Here's the Link to download it:
http://www.komani.de/ASCII-Art(E).exe

And a few examples of Images makeing a very cooll output:

http://www.komani.de/Text.PNG
http://www.komani.de/jing_jang_min.jpg

>A lot of fun with it :D
Apart from that Mrs Lincoln, how was the show?
dkirk
User
User
Posts: 24
Joined: Fri Nov 04, 2005 7:08 pm
Location: Flint, Michigan, USA

Online too

Post by dkirk »

This is provided online, with a few interesting options here:
http://www.text-image.com/index.html
Nik
Addict
Addict
Posts: 1017
Joined: Fri May 13, 2005 11:45 pm
Location: Germany
Contact:

Post by Nik »

They do use a much simpler method, as it seems the system only knows how much balck any character has, while Konnes system compares every character with the area it is in. Which is way more difficult.
xonTAB
User
User
Posts: 24
Joined: Sat Dec 31, 2005 8:40 pm
Location: Fgura, Malta
Contact:

Post by xonTAB »

You did a good job.

I have compared your program with text-image.com (ASCII conversion).

1. I tried http://www.komani.de/Text.PNG on text-image.com but it didn't work.
2. Your program results was more accurate to the original image especially when I used font : Lucida Console, size : 7.
Konne
Enthusiast
Enthusiast
Posts: 434
Joined: Thu May 12, 2005 9:15 pm

Post by Konne »

Here is the Sourcecode:
(IF you don't understand the names of a procedure, or s.th isn't clear just ask)

Code: Select all

UseJPEGImageDecoder()
UsePNGImageDecoder()


Structure Buchstaben
  P.b[104]
EndStructure

Dim A.Buchstaben(255)

LoadFont(20,"Lucida Console",10)

Enumeration
  #Window_0
EndEnumeration
;
Enumeration
  #ProgressBar_0
  #Button_0
  #Image_0
  #TrackBar_0
  #Text_0
  #Text_1
  #Text_2
  #Text_3
  #Button_1
  #Button_2
  #Button_3
  #Button_5
EndEnumeration

Procedure.s GetCurDirectory()
    DefType.l ptrBuffer, lngLen
   
    ptrBuffer = AllocateMemory(#MAX_PATH)
    lngLen = GetCurrentDirectory_(#MAX_PATH, ptrBuffer)
    If Right(PeekS(ptrBuffer, lngLen), 1) <> "\"
        PokeS(ptrBuffer+lngLen, "\"): lngLen+1
    EndIf
   
    ProcedureReturn PeekS(ptrBuffer, lngLen)
EndProcedure

Procedure InitLetters()
CreateImage(5,8,13)

StartDrawing(ImageOutput())
For i = 1 To 255
  
  Box(0,0,8,13,RGB(255,255,255))
  DrawingFont(UseFont(20))
  Locate(0,0)
  DrawText(Chr(i))  
  
  For s=0 To 103
    x=s%8
    y=Round(s/8,0)
    
    If Point(x,y)=0
      A(i)\P[s]=1
    Else
      A(i)\P[s]=0  
    EndIf    
  Next  
  
  ;CallDebugger
Next
StopDrawing()

EndProcedure

Procedure.s MakeAscii(ImageID,Tolleranz)
UseImage(ImageID)
W=ImageWidth()
H=ImageHeight()
Ende=W*H/103
;MessageRequester("Durchgänge","Es werden um die "+Str()+" Durchgänge benötigt")

Start=ElapsedMilliseconds()

B.Buchstaben

StartDrawing(ImageOutput())

For y1 = 0 To H Step 13
  For x1= 0 To W Step 8

    For s=0 To 103
      x=s%8
      y=Round(s/8,0)

      Col=Point(x+x1,y+y1)
      
      If Red(Col)+Green(Col)+Blue(Col)>Tolleranz
        B\P[s]=0  ;weiß
      Else
        B\P[s]=1  ;schwarz
      EndIf  
    Next

    AltSame=-1
    Char=0
    
    For k = 1 To 255
      Same=0
      For u=0 To 103
        If B\P[u]=A(k)\P[u]
          Same+1
        EndIf
      Next
      
      If Same > AltSame        
        AltSame=Same
        Char=k
      EndIf
    Next
   
    String.s+Chr(Char)  
  Durch+1
  If Durch%20 = 5
    SetGadgetState(#ProgressBar_0,Round((Durch/Ende)*100,0))
    SetGadgetText(#Text_3,Str(Durch)+" of "+Str(Ende)+" loops "+Str(Round((Durch/Ende)*100,0))+" %")
    WindowEvent()
  EndIf 
   
  Next
  String.s+Chr(13)+Chr(10)
Next

StopDrawing()

Beep_(100,100)
SetGadgetState(#ProgressBar_0,Ende/Durch*100)
SetGadgetText(#Text_3,"Finished")

ProcedureReturn String.s
EndProcedure

Procedure Window()
  If OpenWindow(#Window_0, 542, 196, 382, 423,  #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar , "Image-ASCII Converter")
    If CreateGadgetList(WindowID())
      ProgressBarGadget(#ProgressBar_0, 3, 393, 279, 24, 0, 100)
      TextGadget(#Text_3, 3, 312, 279, 13, "0%",#PB_Text_Center)
      
      ButtonGadget(#Button_0, 291, 393, 84, 24, "Create ASCII")
      CreateImage(7,285, 273)
      StartDrawing(ImageOutput())
        Box(0,0,285,273,$FFFFFF)
        Locate(285/2-TextLength("Please load an image...")/2,120)
        DrawText("Please load an image...")        
      StopDrawing()  
      ImageGadget(#Image_0, 3, 30, 285, 273, UseImage(7),  #PB_Image_Border )
      TrackBarGadget(#TrackBar_0, 297, 21, 30, 294, 0, 733, #PB_TrackBar_Vertical)
      SetGadgetState(#TrackBar_0,733/2)
      TextGadget(#Text_0, 327, 27, 51, 27, "dark")
      TextGadget(#Text_1, 327, 294, 54, 21, "light")
      TextGadget(#Text_2, 3, 3, 372, 18, "Here you can chance the black and white intesity")
      ButtonGadget(#Button_1, 6, 360, 87, 27, "Load image")
      ButtonGadget(#Button_2, 99, 360, 87, 27, "Save ASCII")
      ButtonGadget(#Button_3, 192, 360, 87, 27, "Show ASCII")
      ButtonGadget(#Button_5, 6, 330, 273, 27, "black-white-image preview")
      
    EndIf
  EndIf
EndProcedure

Procedure MakeImageBAW(Image,Tolleranz)
  UseImage(Image)
  w=ImageWidth()-1
  h=ImageHeight()-1
  
  StartDrawing(ImageOutput())
    For x = 0 To w
      For y = 0 To h
        Col=Point(x,y)
        If Red(Col)+Green(Col)+Blue(Col)>Tolleranz
          Plot(x,y,$FFFFFF)  ;weiß
        Else
          Plot(x,y,0)   ;schwarz
        EndIf  
      Next
    Next
  StopDrawing()
EndProcedure

Procedure LoadBild()
  Para.s=ProgramParameter()
  If Para.s
    Req.s=Para.s  
  Else
    Req.s=OpenFileRequester("Choose an image","D:\Bilder\Schöne Frauen\","Image |*.bmp;*.png;*.jpg",0)
  EndIf
  
  If Req<>""
    If IsImage(6)
      FreeImage(6)
    EndIf
     
    If LoadImage(6,Req.s)=0
      MessageRequester("Error","The program wasn't able to load the image"+Chr(10)+"Name: "+Req.s)
      ProcedureReturn 0
    EndIf
  Else
    ProcedureReturn 0  
  EndIf
 
  ProcedureReturn 1
EndProcedure

Procedure SaveASCII(String.s,Pfad.s)
  If CreateFile(17,Pfad.s)=0
    MessageRequester("Error","It wasn't possible to create a Cout-File."+Chr(10)+Pfad.s)
    ProcedureReturn
  EndIf
  WriteString(String.s)
  CloseFile(17)
EndProcedure

Procedure Eventloop()
  Repeat ; Start of the event loop
    
    Event = WaitWindowEvent() ; This line waits until an event is received from Windows
    
    WindowID = EventWindowID() ; The Window where the event is generated, can be used in the gadget procedures
    
    GadgetID = EventGadgetID() ; Is it a gadget event?
    
    EventType = EventType() ; The event type
    
    ;You can place code here, and use the result as parameters for the procedures
    
    If Event = #PB_EventGadget
      
      If GadgetID = #ProgressBar_0
        
      ElseIf GadgetID = #Button_0;erstellen
        If IsImage(6)
          String.s=MakeAscii(6,GetGadgetState(#TrackBar_0))
        Else
          MessageRequester("Error","You have to load an image first.")
        EndIf  
        ;MessageRequester("",String.s)
        
      ElseIf GadgetID = #Button_1;laden
        If LoadBild()   
          UseImage(7)
          StartDrawing(ImageOutput())
            DrawImage(UseImage(6),0,0,285, 273)
          StopDrawing()
          
          MakeImageBAW(7,GetGadgetState(#TrackBar_0))          
          SetGadgetState(#Image_0,UseImage(7))          
        EndIf
      
      ElseIf GadgetID = #Button_5
        If IsImage(6)=0
          MessageRequester("Error","You have to load an image first.")
        Else
          UseImage(7)
          StartDrawing(ImageOutput())
            DrawImage(UseImage(6),0,0,285, 273)
          StopDrawing() 
          
          MakeImageBAW(7,GetGadgetState(#TrackBar_0))          
          SetGadgetState(#Image_0,UseImage(7))
        EndIf
        
      ElseIf GadgetID = #Button_2;speichern
        If String.s=""
          MessageRequester("Error","You have to create ASCII first.")
        Else
          Wo.s=SaveFileRequester("Saverequester",GetCurDirectory(),"Text|*.txt",0)
          If Wo.s
            SaveASCII(String.s,Wo.s)
          EndIf  
        EndIf
        
      ElseIf GadgetID = #Button_3;sehen
        If String.s=""
          MessageRequester("Error","You have to create ASCII first.")
        Else          
          Name.s=GetCurDirectory()+"Ascii-Cout.txt"
          SaveASCII(String.s,Name.s)
          RunProgram("notepad.exe",Name.s,"")
        EndIf
        
      EndIf
      
    EndIf
    
  Until Event = #PB_Event_CloseWindow ; End of the event loop
  
  End
EndProcedure

InitLetters()
Window()
Eventloop()
Apart from that Mrs Lincoln, how was the show?
rsts
Addict
Addict
Posts: 2736
Joined: Wed Aug 24, 2005 8:39 am
Location: Southwest OH - USA

Post by rsts »

That is really nice.

Thanks for sharing :)

cheers
IdeasVacuum
Always Here
Always Here
Posts: 6425
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

Re: Image to ASCII

Post by IdeasVacuum »

Just had a go at converting this code to PB5.73 but there are so many differences :?
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
User avatar
Keya
Addict
Addict
Posts: 1891
Joined: Thu Jun 04, 2015 7:10 am

Re: Image to ASCII

Post by Keya »

Perhaps another approach - rather than just 'naive' comparing "how much black is in this 2x2 (or 3x3 etc) block of pixels, and which ascii character has the closest level of black" is to use an image comparison algorithm like Structural Similarity Index Measure (SSIM) (or even a simpler comparison metric like MSE or PSNR) to do the comparisons of each block with each of the 256 image-versions of each character

Examples of the more simple metrics in Purebasic of Correlation, Standard Deviation, MSE, RMSE, NRMSE, PSNR:
viewtopic.php?p=501105#p501105
IdeasVacuum
Always Here
Always Here
Posts: 6425
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

Re: Image to ASCII

Post by IdeasVacuum »

Hi Keya

I'm loathe to reinvent a wheel that can already do a good job.
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
User avatar
Keya
Addict
Addict
Posts: 1891
Joined: Thu Jun 04, 2015 7:10 am

Re: Image to ASCII

Post by Keya »

No i didn't mean do a good job, I meant do a better job. And it's just switching from one comparison metric to another - it doesn't really matter what happens within the blackbox function, the inputs and outputs are basically the same ... eg, Procedure CompareBlockToCharacter(*block, *character)

btw here is an interesting PDF about using SSIM vs MRE metrics for image-to-ascii:
http://www.cse.cuhk.edu.hk/~ttwong/pape ... ciiart.pdf
"This project is supported by the Research Grants Council of the Hong Kong Special Administrative Region" -- they even got funding for their image-to-ascii! Wowzers :)
dige
Addict
Addict
Posts: 1247
Joined: Wed Apr 30, 2003 8:15 am
Location: Germany
Contact:

Re: Image to ASCII

Post by dige »

Quick'n dirty converted to PB5.73 .. may be it needs some more conversations - the ascii result looks not so good..

Code: Select all

UseJPEGImageDecoder()
UsePNGImageDecoder()


Structure Buchstaben
  P.b[104]
EndStructure

Global Dim A.Buchstaben(255)

LoadFont(20,"Lucida Console",10)

Enumeration
  #Window_0
EndEnumeration
;
Enumeration
  #ProgressBar_0
  #Button_0
  #Image_0
  #TrackBar_0
  #Text_0
  #Text_1
  #Text_2
  #Text_3
  #Button_1
  #Button_2
  #Button_3
  #Button_5
EndEnumeration

Procedure.s GetCurDirectory()
    Protected ptrBuffer, lngLen
   
    ptrBuffer = AllocateMemory(#MAX_PATH)
    lngLen = GetCurrentDirectory_(#MAX_PATH, ptrBuffer)
    If Right(PeekS(ptrBuffer, lngLen), 1) <> "\"
        PokeS(ptrBuffer+lngLen, "\"): lngLen+1
    EndIf
   
    ProcedureReturn PeekS(ptrBuffer, lngLen)
EndProcedure

Procedure InitLetters()
CreateImage(5,8,13)

StartDrawing(ImageOutput(5))
For i = 1 To 255
 
  Box(0,0,8,13,RGB(255,255,255))
  DrawingFont(FontID(20))
  
  DrawText(0, 0, Chr(i)) 
 
  For s=0 To 103
    x=s%8
    y=Round(s/8,0)
   
    If Point(x,y)=0
      A(i)\P[s]=1
    Else
      A(i)\P[s]=0 
    EndIf   
  Next 
 
  ;CallDebugger
Next
StopDrawing()

EndProcedure

Procedure.s MakeAscii(ImageID,Tolleranz)

W=ImageWidth(ImageID)
H=ImageHeight(ImageID) 
Ende=W*H/103
;MessageRequester("Durchgänge","Es werden um die "+Str()+" Durchgänge benötigt")

Start=ElapsedMilliseconds()

B.Buchstaben

StartDrawing(ImageOutput(ImageID))

For y1 = 0 To H Step 13
  For x1= 0 To W Step 8

    For s=0 To 103
      x=s%8
      y=Round(s/8,0)
      
      If x+x1 < W And y+y1 < h
        Col=Point(x+x1,y+y1)
       
        If Red(Col)+Green(Col)+Blue(Col)>Tolleranz
          B\P[s]=0  ;weiß
        Else
          B\P[s]=1  ;schwarz
        EndIf 
      EndIf
    Next

    AltSame=-1
    Char=0
   
    For k = 1 To 255
      Same=0
      For u=0 To 103
        If B\P[u]=A(k)\P[u]
          Same+1
        EndIf
      Next
     
      If Same > AltSame       
        AltSame=Same
        Char=k
      EndIf
    Next
   
    String.s+Chr(Char) 
  Durch+1
  If Durch%20 = 5
    SetGadgetState(#ProgressBar_0,Round((Durch/Ende)*100,0))
    SetGadgetText(#Text_3,Str(Durch)+" of "+Str(Ende)+" loops "+Str(Round((Durch/Ende)*100,0))+" %")
    WindowEvent()
  EndIf
   
  Next
  String.s+Chr(13)+Chr(10)
Next

StopDrawing()

Beep_(100,100)
SetGadgetState(#ProgressBar_0,Ende/Durch*100)
SetGadgetText(#Text_3,"Finished")

ProcedureReturn String.s
EndProcedure

Procedure Window()
  If OpenWindow(#Window_0, 542, 196, 382, 423, "Image-ASCII Converter", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar )

      ProgressBarGadget(#ProgressBar_0, 3, 393, 279, 24, 0, 100)
      TextGadget(#Text_3, 3, 312, 279, 13, "0%",#PB_Text_Center)
     
      ButtonGadget(#Button_0, 291, 393, 84, 24, "Create ASCII")
      CreateImage(7,285, 273)
      StartDrawing(ImageOutput(7))
        Box(0,0,285,273,$FFFFFF)

        DrawText(285/2-TextWidth("Please load an image...")/2,120, "Please load an image...")       
      StopDrawing() 
      ImageGadget(#Image_0, 3, 30, 285, 273, ImageID(7),  #PB_Image_Border )
      TrackBarGadget(#TrackBar_0, 297, 21, 30, 294, 0, 733, #PB_TrackBar_Vertical)
      SetGadgetState(#TrackBar_0,733/2)
      TextGadget(#Text_0, 327, 27, 51, 27, "dark")
      TextGadget(#Text_1, 327, 294, 54, 21, "light")
      TextGadget(#Text_2, 3, 3, 372, 18, "Here you can chance the black and white intesity")
      ButtonGadget(#Button_1, 6, 360, 87, 27, "Load image")
      ButtonGadget(#Button_2, 99, 360, 87, 27, "Save ASCII")
      ButtonGadget(#Button_3, 192, 360, 87, 27, "Show ASCII")
      ButtonGadget(#Button_5, 6, 330, 273, 27, "black-white-image preview")
     

  EndIf
EndProcedure

Procedure MakeImageBAW(Image,Tolleranz)
  
  w=ImageWidth(Image)-1
  h=ImageHeight(Image)-1
 
  StartDrawing(ImageOutput(Image))
    For x = 0 To w
      For y = 0 To h
        Col=Point(x,y)
        If Red(Col)+Green(Col)+Blue(Col)>Tolleranz
          Plot(x,y,$FFFFFF)  ;weiß
        Else
          Plot(x,y,0)   ;schwarz
        EndIf 
      Next
    Next
  StopDrawing()
EndProcedure

Procedure LoadBild()
  Para.s=ProgramParameter()
  If Para.s
    Req.s=Para.s 
  Else
    Req.s=OpenFileRequester("Choose an image","D:\Bilder\Schöne Frauen\","Image |*.bmp;*.png;*.jpg",0)
  EndIf
 
  If Req<>""
    If IsImage(6)
      FreeImage(6)
    EndIf
     
    If LoadImage(6,Req.s)=0
      MessageRequester("Error","The program wasn't able to load the image"+Chr(10)+"Name: "+Req.s)
      ProcedureReturn 0
    EndIf
  Else
    ProcedureReturn 0 
  EndIf
 
  ProcedureReturn 1
EndProcedure

Procedure SaveASCII(String.s,Pfad.s)
  Debug Pfad
  If CreateFile(17,Pfad.s)=0
    MessageRequester("Error","It wasn't possible to create a Cout-File."+Chr(10)+Pfad.s)
    ProcedureReturn
  EndIf
  WriteString(17, String.s)
  CloseFile(17)
EndProcedure

Procedure Eventloop()
  Repeat ; Start of the event loop
   
    Event = WaitWindowEvent() ; This line waits until an event is received from Windows
   
    WindowID = EventWindow() ; The Window where the event is generated, can be used in the gadget procedures
   
    GadgetID = EventGadget() ; Is it a gadget event?
   
    EventType = EventType() ; The event type
   
    ;You can place code here, and use the result as parameters for the procedures
   
    If Event = #PB_Event_Gadget
     
      If GadgetID = #ProgressBar_0
       
      ElseIf GadgetID = #Button_0;erstellen
        If IsImage(6)
          String.s=MakeAscii(6,GetGadgetState(#TrackBar_0))
        Else
          MessageRequester("Error","You have to load an image first.")
        EndIf 
        ;MessageRequester("",String.s)
       
      ElseIf GadgetID = #Button_1;laden
        If LoadBild()   

          StartDrawing(ImageOutput(7))
            DrawImage(ImageID(6),0,0,285, 273)
          StopDrawing()
         
          MakeImageBAW(7,GetGadgetState(#TrackBar_0))         
          SetGadgetState(#Image_0, ImageID(7))         
        EndIf
     
      ElseIf GadgetID = #Button_5
        If IsImage(6)=0
          MessageRequester("Error","You have to load an image first.")
        Else
          
          StartDrawing(ImageOutput(7))
            DrawImage(ImageID(6),0,0,285, 273)
          StopDrawing()
         
          MakeImageBAW(7,GetGadgetState(#TrackBar_0))         
          SetGadgetState(#Image_0,ImageID(7))
        EndIf
       
      ElseIf GadgetID = #Button_2;speichern
        If String.s=""
          MessageRequester("Error","You have to create ASCII first.")
        Else
          Wo.s=SaveFileRequester("Saverequester",GetCurDirectory(),"Text|*.txt",0)
          If Wo.s
            SaveASCII(String.s,Wo.s)
          EndIf 
        EndIf
       
      ElseIf GadgetID = #Button_3;sehen
        If String.s=""
          MessageRequester("Error","You have to create ASCII first.")
        Else         
          Name.s=GetTemporaryDirectory() + "Ascii-Cout.txt"
          SaveASCII(String.s,Name.s)
          RunProgram("notepad.exe",Name.s,"")
        EndIf
       
      EndIf
     
    EndIf
   
  Until Event = #PB_Event_CloseWindow ; End of the event loop
 
  End
EndProcedure

InitLetters()
Window()
Eventloop()
"Daddy, I'll run faster, then it is not so far..."
User avatar
Demivec
Addict
Addict
Posts: 4086
Joined: Mon Jul 25, 2005 3:51 pm
Location: Utah, USA

Re: Image to ASCII

Post by Demivec »

dige wrote:Quick'n dirty converted to PB5.73 .. may be it needs some more conversations - the ascii result looks not so good..
I did a slightly more elaborate conversion / update also but the program's output was horrible as well. I haven't yet compiled the original code to see if the output was the same. The conversion was straight forward and so that means the coded solution has problems.
IdeasVacuum
Always Here
Always Here
Posts: 6425
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

Re: Image to ASCII

Post by IdeasVacuum »

Hi Dige

Well at least you got an ASCII result, mine is just stripes (although that looks cool too).
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
IdeasVacuum
Always Here
Always Here
Posts: 6425
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

Re: Image to ASCII

Post by IdeasVacuum »

Hi Keya

Well, Konne's original work received very high praise and that is why I thought it better to upgrade it to 5.73 instead of a total rewrite. I should probably compile it in the original PB version to see - v4.00
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
IdeasVacuum
Always Here
Always Here
Posts: 6425
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

Re: Image to ASCII

Post by IdeasVacuum »

Sooo, tried compiling Konne's code in v4.00 32bit but it fails @ line 33 - garbage at end of line. :mrgreen:
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
Post Reply