Image to ASCII

Konne · Post by **Konne** » Thu Jan 05, 2006 8:20 pm

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

dkirk · Post by **dkirk** » Thu Jan 05, 2006 11:38 pm

This is provided online, with a few interesting options here:
http://www.text-image.com/index.html

Nik · Post by **Nik** » Fri Jan 06, 2006 12:25 am

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 · Post by **xonTAB** » Fri Jan 06, 2006 5:15 pm

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 · Post by **Konne** » Sat Jan 07, 2006 2:36 pm

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()

rsts · Post by **rsts** » Sat Jan 07, 2006 3:47 pm

That is really nice.

Thanks for sharing

cheers

IdeasVacuum · Post by **IdeasVacuum** » Sat Apr 10, 2021 5:05 pm

Just had a go at converting this code to PB5.73 but there are so many differences

Keya · Post by **Keya** » Sat Apr 10, 2021 8:04 pm

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 · Post by **IdeasVacuum** » Sun Apr 11, 2021 3:31 am

Hi Keya

I'm loathe to reinvent a wheel that can already do a good job.

Keya · Post by **Keya** » Sun Apr 11, 2021 5:36 am

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 · Post by **dige** » Mon Apr 12, 2021 9:20 am

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()

Demivec · Post by **Demivec** » Mon Apr 12, 2021 9:50 am

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 · Post by **IdeasVacuum** » Mon Apr 12, 2021 12:17 pm

Hi Dige

Well at least you got an ASCII result, mine is just stripes (although that looks cool too).

IdeasVacuum · Post by **IdeasVacuum** » Mon Apr 12, 2021 12:25 pm

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 · Post by **IdeasVacuum** » Mon Apr 12, 2021 12:37 pm

Sooo, tried compiling Konne's code in v4.00 32bit but it fails @ line 33 - garbage at end of line.

PureBasic Forums - English

Image to ASCII

Image to ASCII

Online too

Re: Image to ASCII

Re: Image to ASCII

Re: Image to ASCII

Re: Image to ASCII

Re: Image to ASCII

Re: Image to ASCII

Re: Image to ASCII

Re: Image to ASCII

Re: Image to ASCII