PureBasic

Code : Tout sélectionner

; (c)djes 2016
; Fast and ugly code to convert an image to ASCII based on character design
; http://www.purebasic.fr/french/viewtopic.php?f=6&t=16329

UseJPEGImageDecoder()
UsePNGImageDecoder()

#Threshold = 100 ;"seuil"

If LoadFont(0, "Terminal", 8) = 0
  MessageRequester("Error", "Can't load font", 0)
  End
EndIf

If CreateImage(0, 8 * 256, 8)
  
  If StartDrawing(ImageOutput(0))
    
    ;Creates pixel matrices for all the font characters
    Dim CharsPixels.b(256, 8, 8)
    
    Box(0, 0, 8*256, 8, RGB(255, 255, 255)) 
    DrawingMode(1)
    DrawingFont(FontID(0))
    
    For i = 32 To 255
      DrawText(8 * i, 0, Chr(i), 0)
      For y = 0 To 7
        For x = 0 To 7
          If Point(x + i * 8, y) = 0
            CharsPixels(i, x, y) = 1
          EndIf
        Next x
      Next y
    Next i
    
    StopDrawing()
    
  EndIf
  
  FileName.s = OpenFileRequester("Choose an image file to load", #PB_Compiler_FilePath, "Pictures|*.jpg;*.png", 0)
  SetGadgetFont(#PB_Default, FontID(0)) 
  
  If LoadImage(1, FileName) = 0
    MessageRequester("Error", "Can't load image", 0)
    End
  EndIf
  
  If ImageWidth(1) > 600
    ResizeImage(1, 600, #PB_Ignore)  
  EndIf
  If ImageHeight(1) > 600
    ResizeImage(1, #PB_Ignore, 600)  
  EndIf
  
  If OpenWindow(0, 0, 0, ImageWidth(1) * 2, ImageHeight(1), "GFX2ASCII", #PB_Window_SystemMenu | #PB_Window_ScreenCentered) = 0
    MessageRequester("Error", "Can't open window", 0)
    End
  EndIf
  
  CanvasGadget(0, 0, 0, ImageWidth(1) + 8, ImageHeight(1) + 8)
  EditorGadget(1, ImageWidth(1), 0, ImageWidth(1), ImageHeight(1))
  
  FileName.s = OpenFileRequester("Choose an ASCII file to save", #PB_Compiler_FilePath + "result.txt", "", 0)
  If CreateFile(0, FileName)
    
    StartDrawing(CanvasOutput(0))
    Box(0, 0, ImageWidth(1) + 8, ImageHeight(1) + 8, RGB(255, 255, 255)) ; White background
    DrawImage(ImageID(1), 0, 0) 
    
    For yc = 0 To ImageHeight(1) - 1 Step 8
      
      TextLine.s = ""
      
      For xc = 0 To ImageWidth(1) - 1 Step 8
        
        Dim ThisCharPixels.b(8, 8)
        
        ;Creates a char matrix for each 8x8 block
        For y = 0 To 7
          For x = 0 To 7
            Color = Point(xc + x, yc + y)
            Gray = 0.299 * Red(Color) + 0.587 * Green(Color) + 0.114 * Blue(Color)
            If Gray < #Threshold
              Plot(xc + x, yc + y, RGB($FF, 0, 0))
              ThisCharPixels(x, y) = 1  
            EndIf
          Next x
        Next y
        
        BestKnownScore = 0
        ChoosenChar = 0
        
        For i = 32 To 255
          
          ;Try to find the best char
          ThisCharScore = 0
          For y = 0 To 7
            For x = 0 To 7
              If CharsPixels(i, x, y) = ThisCharPixels(x, y) 
                ThisCharScore + 1
              EndIf
            Next x
          Next y
          
          ;Use the best corresponding char
          If ThisCharScore > BestKnownScore
            ChoosenChar = i
            BestKnownScore = ThisCharScore
            
            ;Draw the corresponding char on the image
            For y = 0 To 7
              For x = 0 To 7
                If CharsPixels(i, x, y) = 1 
                  Plot(xc + x, yc + y, RGB(0, 0, 0))
                EndIf
              Next x
            Next y  
            
          EndIf
          
        Next i
        
        TextLine + Chr(ChoosenChar)
        WriteAsciiCharacter(0, ChoosenChar)
        
      Next xc
      
      AddGadgetItem(1, -1, TextLine) 
      WriteStringN(0, "", #PB_Ascii)
      
    Next yc
    
    StopDrawing()  
    CloseFile(0)
    
    Repeat
      
      Event = WaitWindowEvent()
      
    Until Event = #PB_Event_CloseWindow    ; If the user has pressed on the close button
    
  EndIf
EndIf

End