Picture to text converter

[MasterGy]

Hello !

Out of curiosity, I created a program for converting images to characters.
There are so many online, there are also online converters.

I tried to add something extra. It also works with variable character width, and the shades of the image can be adjusted.

Enter the image and font in the source code. You can change what characters it uses.

When the program starts, the optimal image can be adjusted with brightness/contrast.
It is possible to set how many lines the image is displayed.
Black characters on a white background or white characters on a black background.
The width of the letter can be adjusted. (1- original 0.5, half as wide, 2, double wide)
You can set the size of the map to work on. This is important when saving, because the image can be saved in very good quality.

The program does not require external files.
Give it a picture and start it.

Code: (Select All)

'MasterGy 2022
Dim Shared pic, contrast, brightness, contrast_ref, char_collection$


'CHANGES SETTING ! ----------------------------------------------------------------------------------------------------------------------


picture$ = "image1.jpg" ' <------ set a picture
char_collection$ = "'+0123456789.?!=:>()<%/-,ABCDEFGHIJKLMNOPQRSTVXYZUWabcdefghijklmnopqrstvxyzuw" '<----- charecters used
type_s$ = Environ$("systemroot") + "/fonts/arial.ttf" '<------ font type

'------------------------------------------------------------------------------------------------------------------------------











s$ = " Press S to save BMP file     , ESC to return menu ": _Font 16
mess = _NewImage(8 * Len(s$), 16, 32): _Dest mess: Cls , _RGB32(100, 0, 0, 100): Color _RGB32(255, 255, 255, 255), _RGB32(100, 0, 0, 100): Locate 1, 1: Print s$;

pic_size = 500

temp = _LoadImage(picture$, 32): _Source temp
If _Width(temp) > _Height(temp) Then x = pic_size: y = Int(x / _Width(temp) * _Height(temp)) Else y = pic_size: x = Int(y / _Height(temp) * _Width(temp))
pic = _NewImage(x, y, 32): _Dest pic: _PutImage: _FreeImage temp


s_c = 7
s$(0) = "contrast": s(0, 0) = 1.5: s(0, 1) = 1: s(0, 2) = 7
s$(1) = "contrast_ref": s(1, 0) = 128: s(1, 1) = 0: s(1, 2) = 255
s$(2) = "brigthness": s(2, 0) = 0: s(2, 1) = -255: s(2, 2) = 255
s$(3) = "types rows": s(3, 0) = 75: s(3, 1) = 10: s(3, 2) = 200
s$(4) = "output picture size": s(4, 0) = _DesktopWidth: s(4, 1) = 300: s(4, 2) = 3000
s$(5) = "picture colors negate": s(5, 0) = 1: s(5, 1) = 0: s(5, 2) = 1
s$(6) = "type width-ratio": s(6, 0) = 1: s(6, 1) = .5: s(6, 2) = 4


s_sy = Int((y / 16) + 2): winx = x + 100: winy = (s_sy + s_c * 3 + 3) * 16 + 1: x_size = winx * .7
win = _NewImage(winx, winy, 32): Screen win: _FullScreen _SquarePixels , _Smooth

Do: _Limit 30


    k$ = InKey$
    Select Case k$
        Case Chr$(27): System
        Case "1", "2", "3": work_type = Val(k$): GoSub work
    End Select
    mousew = 0: While _MouseInput: mousew = mousew + _MouseWheel: Wend: If _MouseButton(1) = 0 Then mc = -1
    s(3, 0) = Int(s(3, 0))
    s(4, 0) = Int(s(4, 0))
    s(5, 0) = CInt(s(5, 0))
    s(7, 0) = CInt(s(7, 0))
    For sa = 0 To s_c - 1
        y1 = (s_sy + sa * 3 - 1) * 16 + 20: y2 = y1 + 14: x1 = (winx - x_size) / 2: x2 = x1 + x_size
        under2 = _MouseX > x1 And _MouseX < x2: under = under2 And _MouseY > y1 And _MouseY < y2
        mgrey = 128 + (CInt(s(5, 0)) * 2 - 1) * 127 * under
        Color _RGB(mgrey, mgrey, mgrey)
        s$ = s$(sa) + "  (" + LTrim$(Str$(Int(s(sa, 0) * 100) / 100)) + ")"
        If sa = 4 Then s$ = s$(sa) + "  (" + LTrim$(Str$(Int(s(sa, 0)))) + " x " + LTrim$(Str$(Int(s(sa, 0) / x * y))) + ")"
        Locate s_sy + sa * 3, (winx - Len(s$) * 8) / 16: Print UCase$(s$)
        Color _RGB(200, 40, 40): Line (x1, y1)-(x2, y2), , B
        x2 = x1 + x_size / (s(sa, 2) - s(sa, 1)) * (s(sa, 0) - s(sa, 1)): Line (x1, y1)-(x2, y2), , BF
        If under And _MouseButton(1) And mc = -1 Then mc = sa
    Next sa

    If mc <> -1 And under2 And mc <> 5 Then s(mc, 0) = (s(mc, 2) - s(mc, 1)) * (1 / x_size * (_MouseX - (winx - x_size) / 2)) + s(mc, 1)
    If mc = 5 And under2 And m5last = 0 Then s(5, 0) = 1 - s(5, 0): m5last = 1
    m5last = m5last And -_MouseButton(1)

    contrast = s(0, 0): contrast_ref = s(1, 0): brightness = s(2, 0)

    'statistic
    min = 999999: max = -min: _Dest mon: _Source pic
    For tx = 0 To x - 1: For ty = 0 To y - 1: grey = pic_read(tx, ty): If grey > max Then max = grey
        If grey < min Then min = grey
    Next ty, tx

    'draw
    temp = 255 / (max - min)
    sx = (winx - x) / 2: For tx = 0 To x - 1: For ty = 0 To y - 1: grey = temp * (pic_read(tx, ty) - min): PSet (sx + tx, ty), _RGB(grey, grey, grey): Next ty, tx


    _Display

    grey = 255 * CInt(s(5, 0))
    Cls , _RGB(grey, grey, grey)
    Color _RGB(50, 128, 50), 0
    Locate Int(winy / 16) - 3, 3: Print "-1- work variable character width";
    Locate Int(winy / 16) - 2, 3: Print "-2- work same character width";
    Locate Int(winy / 16) - 1, 3: Print "-3- work random character location";

Loop



'work
work:

Cls


_AutoDisplay
monx2 = Int(s(4, 0))
mony2 = Int(s(4, 0) / x * y)
t_height = Int(mony2 / s(3, 0))

temp = _LoadImage(picture$, 32): _Source temp: pic_work = _NewImage(monx2, mony2, 32): _Dest pic_work: _PutImage: _Source pic_work: _FreeImage temp
pic_out = _NewImage(monx2, mony2, 32)
temp = 255 / (max - min)
For tx = 0 To monx2 - 1: For ty = 0 To mony2 - 1: grey = temp * (pic_read(tx, ty) - min): PSet (tx, ty), _RGB(grey, grey, grey): Next ty, tx


mon2 = _NewImage(monx2, mony2, 32): Screen mon2


negate = CInt(s(5, 0))
ReDim Shared font_collection(255, 2): font_install type_s$, t_height * 2, negate, Abs(work_type = 2): _Font 16



_Dest pic_out
Cls , _RGB(255 * negate, 255 * negate, 255 * negate)
_FullScreen _SquarePixels , _Smooth


Select Case work_type
    Case 1, 2
        ReDim st(499, 1)
        Do: For a_row = 0 To Int(s(3, 0)) - 1
            _Source pic_out: _Dest mon2: _PutImage
            _Source mess: _PutImage (0, 0)-(_Width(mon2), _Width(mon2) / _Width(mess) * _Height(mess)): _Display
            _Dest pic_out
            a_col = 0
            Do
                _Source pic_work
                dif_ok = 99999
                For ac = 0 To Len(char_collection$) - 1

                Select Case LCase$(InKey$): Case Chr$(27): GoTo return_menu: Case "s": GoTo saving: End Select

                        x1 = a_col
                        stx = Int(t_height / _Height(font_collection(ac + 1, 0)) * _Width(font_collection(ac + 1, 0)))
                        x2 = x1 + Int(s(6, 0) * stx)
                        If x2 > monx2 Then Exit Do
                        y1 = a_row * t_height
                        y2 = y1 + t_height


                        If st(stx, 0) = a_col Then
                            st = st(stx, 1)
                        Else
                            sum = 0: c = 0: For tx = x1 To x2
                            For ty = y1 To y2: sum = sum + _Red(Point(tx, ty)): c = c + 1: Next ty, tx
                            st(stx, 0) = a_col
                            st = sum / (255 * c)
                            st(stx, 1) = st
                        End If

                        dif = Abs(st - font_collection(ac + 1, 2))
                        If dif < dif_ok Then dif_ok = dif: st_need = ac: x2_need = x2
                    Next ac

                    _Source font_collection(st_need + 1, 0)
                    _PutImage (x1, y1)-(x2_need, y2)
                    a_col = x2_need + 1
                Loop

        Next a_row: Loop

    Case 3
        Do
            cn = cn + 1: If cn > 100 Then
                _Source pic_out: _Dest mon2: _PutImage
                _Source mess: _PutImage (0, 0)-(_Width(mon2), _Width(mon2) / _Width(mess) * _Height(mess)): _Display
                cn = 0
            End If
            _Dest pic_out

        Select Case LCase$(InKey$): Case Chr$(27): GoTo return_menu: Case "s": GoTo saving: End Select
            xsize = Int(t_height * (1 + .5 * Rnd))
            ysize = Int(t_height * (1 + .5 * Rnd))
            xpos = Int((monx2 - xsize) * Rnd)
            ypos = Int((mony2 - ysize) * Rnd)

            sum = 0: c = 0: For tx = 0 To xsize - 1
                _Source pic_work
            For ty = 0 To ysize - 1: sum = sum + _Red(Point(tx + xpos, ty + ypos)): c = c + 1: Next ty, tx
            st = sum / (255 * c)
            dif_ok = 99999
            For ac = 0 To Len(char_collection$) - 1
                dif = Abs(st - font_collection(ac + 1, 2))
                If dif < dif_ok Then dif_ok = dif: st_need = ac
            Next ac
            _Source font_collection(st_need + 1, 0)
            _PutImage (xpos, ypos)-(xpos + xsize, ypos + ysize)
        Loop


End Select


saving: _AutoDisplay: Screen 0: _FullScreen _Off: Cls: Print "saving picture to SAVED.BMP...waiting": SaveImage pic_out, "saved.bmp": Sleep 2: System

return_menu: Screen win: _Dest win: _Source win: _Font 16: _FreeImage mon2: _FreeImage pic_work: _FreeImage pic_out: Return




Sub font_install (f$, fs, negate, mono)
    If mono Then af = _LoadFont(f$, fs, "monospace") Else af = _LoadFont(f$, fs)
    For ac = 0 To Len(char_collection$) - 1: ac$ = Mid$(char_collection$, ac + 1, 1): _Font af
        temp2 = _NewImage(_PrintWidth(ac$), fs, 32): _Dest temp2: Cls , _RGB(255 * negate, 255 * negate, 255 * negate)

        _Font af: Color _RGB(255 * (negate Xor 1), 255 * (negate Xor 1), 255 * (negate Xor 1)), 0
        _PrintString (0, 0), ac$: font_collection(ac + 1, 0) = _CopyImage(temp2, 32): _Source temp2

        c = 0: st = 0: For tx = 0 To _Width(temp2) - 1: For ty = 0 To _Height(temp2) - 1: c = c + 1: st = st + Abs(_Red(Point(tx, ty)) <> _Red(tc&&)): Next ty, tx
        font_collection(ac + 1, 2) = 1 / c * st: _FreeImage temp2
    font_collection(ac + 1, 1) = Asc(ac$): Next ac
    font_collection(0, 0) = af

    min_g = 99999: max_g = -min_g

    For t = 0 To Len(char_collection$) - 1 'find limits
        If font_collection(t + 1, 2) < min_g Then min_g = font_collection(t + 1, 2)
        If font_collection(t + 1, 2) > max_g Then max_g = font_collection(t + 1, 2)
    Next t

    For t = 0 To Len(char_collection$) - 1 'normalizing limits
        font_collection(t + 1, 2) = 1 / (max_g - min_g) * (font_collection(t + 1, 2) - min_g)
    Next t
End Sub


Function pic_read (tx, ty)
    p&& = Point(tx, ty): grey = (_Red(p&&) + _Green(p&&) + _Blue(p&&)) * .33333
    grey = contrast_ref + (grey - contrast_ref) * contrast + brightness
    If grey < 0 Then grey = 0
    If grey > 255 Then grey = 255
    pic_read = grey
End Function



Sub SaveImage (image As Long, filename As String)
    bytesperpixel& = _PixelSize(image&)
    If bytesperpixel& = 0 Then Print "Text modes unsupported!": End
    If bytesperpixel& = 1 Then bpp& = 8 Else bpp& = 24
    x& = _Width(image&)
    y& = _Height(image&)
    b$ = "BM????QB64????" + MKL$(40) + MKL$(x&) + MKL$(y&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + String$(16, 0) 'partial BMP header info(???? to be filled later)
    If bytesperpixel& = 1 Then
        For c& = 0 To 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
            cv& = _PaletteColor(c&, image&) ' color attribute to read.
            b$ = b$ + Chr$(_Blue32(cv&)) + Chr$(_Green32(cv&)) + Chr$(_Red32(cv&)) + Chr$(0) 'spacer byte
        Next
    End If
    Mid$(b$, 11, 4) = MKL$(Len(b$)) ' image pixel data offset(BMP header)
    lastsource& = _Source
    _Source image&
    If ((x& * 3) Mod 4) Then padder$ = String$(4 - ((x& * 3) Mod 4), 0)
    For py& = y& - 1 To 0 Step -1 ' read JPG image pixel color data
        r$ = ""
        For px& = 0 To x& - 1
            c& = Point(px&, py&) 'POINT 32 bit values are large LONG values
            If bytesperpixel& = 1 Then r$ = r$ + Chr$(c&) Else r$ = r$ + Left$(MKL$(c&), 3)
        Next px&
        d$ = d$ + r$ + padder$
    Next py&
    _Source lastsource&
    Mid$(b$, 35, 4) = MKL$(Len(d$)) ' image size(BMP header)
    b$ = b$ + d$ ' total file data bytes to create file
    Mid$(b$, 3, 4) = MKL$(Len(b$)) ' size of data file(BMP header)
    If LCase$(Right$(filename$, 4)) <> ".bmp" Then ext$ = ".bmp"
    f& = FreeFile
    Open filename$ + ext$ For Output As #f&: Close #f& ' erases an existing file
    Open filename$ + ext$ For Binary As #f&
    Put #f&, , b$
    Close #f&
End Sub

[Pete]

It's true. Chicks look hotter in SCREEN 0!

Pete

[bplus]

I keep getting errors about invalid handle line 185 +

[MasterGy]

I keep getting errors about invalid handle line 185 +

I just updated it, replaced it, now it works about 5x faster.

Bplus! Is the image generation successful? I don't understand what could be wrong.

[Pete]

The invalid handle happens if you don't get a jpeg and put in in your local folder named as image1.jpg

In the code, picture$ = "image1.jpg"

temp = _LOADIMAGE(picture$, 32): _SOURCE temp

So if no image1.jpg in the folder, no handle.

I just renamed one of the jpegs already in my QB64PE folder, and it worked fine, as advertised.

Pete

[MasterGy]

The invalid handle happens if you don't get a jpeg and put in in your local folder named as image1.jpg

In the code, picture$ = "image1.jpg"

temp = _LOADIMAGE(picture$, 32): _SOURCE temp

So if no image1.jpg in the folder, no handle.

I just renamed one of the jpegs already in my QB64PE folder, and it worked fine, as advertised.

Pete

Yes, I wrote it at the beginning. Just enter a picture in the source (picture$ = "....") and start it!

[mnrvovrfc]

What, no "_MAPTRIANGLE"? :O

Just joking, thanks for this program. This is a lot like the "neofetch" and "screenfetch" that are usually to show off what Linux distro somebody is running at the time.

LIKE THIS:



(Not a good example LOL but it uses the equivalent of CP437/CHR$(219) block characters.)

[Pete]

LOL @ No _MAPTRIANGLE

Let me show you my shocked face...

[mnrvovrfc]

I guess the colons and exclamation points at the top and bottom lines of the built screen are intentional.

It's difficult with the mouse to set some values with the sliders. For the life of me I cannot get to 200 text rows (middle slider), and I cannot set the minimum value less than 640x640.

I changed this program a bit so it worked on Linux. With the way I changed it, it was meant to be run at the terminal command line. The first parameter is the full path to an image file. It could be easily changed to use the fancy open-file dialog. The "saved.bmp" part wasn't changed. I show the changes from the top up to and including "pic_size = 500" line.

The check has to do firstly with the path to the monospaced font file, and secondly with the font file. The "DejaVuSansMono" is being targeted because Manjaro in particular doesn't have an actual font file called "Monospace". It's treated like a "tag" set eg. in Kate which is irritating.

EDIT: Fedora 37 doesn't carry "lsb_release" in the ISO's, must be installed. It does have "inxi". It was a PITA otherwise being different from Manjaro and Slackware, and not having the font file that I desired. That ugly-ass "Google Noto" LOL. Of course this could be changed to another monospaced font which exists on the system.

Darn it, became full of myself writing the above! Thank you to the writers of "setup_lnx.sh" for QB64PE, to obtain a way to get which Linux distro is running.

Code: (Select All)

Dim Shared pic, contrast, brightness, contrast_ref, char_collection$


'changes settings !

picture$ = command$(1) ' <------ set a picture
if picture$ = "" then
    print "Please give the name of a picture as command-line argument!"
    end
end if
if not _fileexists(picture$) then
    print "Please give the full path name of a picture that exists!"
    end
end if

char_collection$ = "'+0123456789.?!=:>()<%/-,ABCDEFGHIJKLMNOPQRSTVXYZUWabcdefghijklmnopqrstvxyzuw" '<----- characters used
'char_collection$ = "0123456789"
$IF WIN THEN
type_s$ = Environ$("systemroot") + "/fonts/arial.ttf" '<------ font type
$ELSE
'thanks to "qb64pe/setup_lnx.sh"
afile$ = "/tmp/distro_name.txt"
zcmd$ = "lsb_release -si > " + afile$
sta% = _shellhide(zcmd$)
if sta% > 0 then
    zcmd$ = "inxi -x -S > " + afile$
    stu% = _shellhide(zcmd$)
end if
atext$ = ""
if _fileexists(afile$) then
    ff& = freefile
    open afile$ for input as ff&
    line input #ff&, atext$
    if sta% > 0 then
        for ii% = 1 to 3
            if instr(atext$, "Distro: ") > 0 then exit for
            if eof(ff&) then exit for
            line input #ff&, atext$
        next
    end if
    close ff&
end if
'only four distros are tested LOL, need to test Fedora on my other HP laptop
if instr(atext$, "Manjaro") > 0 or instr(atext$, "slackware") > 0 then
    type_s$ = "/usr/share/fonts/TTF/DejaVuSansMono.ttf"
elseif instr(atext$, "Fedora") > 0 then
    'geez I despise this font with that godawful "r"
    type_s$ = "/usr/share/fonts/google-noto-vf/NotoSansMono-VF.ttf"
else
    'this should be for Debian
    type_s$ = "/usr/share/fonts/truetype/dejavu/DejaVuSansMono.ttf"
end if
$END IF

'------------------------------------------------------------------------------------------------------------------------------


pic_size = 500

[bplus]

OK works now used same pic and same font specs:

   
Some chicks