+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Prolific Programmers (https://staging.qb64phoenix.com/forumdisplay.php?fid=26)
+---- Forum: MasterGy (https://staging.qb64phoenix.com/forumdisplay.php?fid=45)
+---- Thread: Picture to text converter (/showthread.php?tid=1241)
Pages:
1
2
Picture to text converter - MasterGy - 12-06-2022
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 SubRE: Picture to text converter - Pete - 12-06-2022
It's true. Chicks look hotter in SCREEN 0!
Pete
RE: Picture to text converter - bplus - 12-06-2022
I keep getting errors about invalid handle line 185 +
RE: Picture to text converter - MasterGy - 12-06-2022
(12-06-2022, 09:03 PM)bplus Wrote: 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.
RE: Picture to text converter - Pete - 12-06-2022
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
RE: Picture to text converter - MasterGy - 12-06-2022
(12-06-2022, 09:27 PM)Pete Wrote: 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!
RE: Picture to text converter - mnrvovrfc - 12-06-2022
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:
![[Image: reply-phoenix-neofetch.png]](https://i.ibb.co/X8XTRfc/reply-phoenix-neofetch.png)
(Not a good example LOL but it uses the equivalent of CP437/CHR$(219) block characters.)
RE: Picture to text converter - Pete - 12-06-2022
LOL @ No _MAPTRIANGLE
Let me show you my shocked face...
![[Image: Sam_surprised.gif]](http://static2.wikia.nocookie.net/__cb20110827214238/looneytunes/images/e/e0/Sam_surprised.gif)
RE: Picture to text converter - mnrvovrfc - 12-06-2022
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 = 500RE: Picture to text converter - bplus - 12-06-2022
OK works now used same pic and same font specs:
Some chicks