Program for neat display of long text

[Petr]

This program has one goal. Divide the text where it is expected, ie where there is a space in the text. It looks funny now, but - I went to it so badly again, I won't even describe it, you wouldn't want to believe it anyway...

It's not visible, but - I mean - so much work and so much nonsense. I spend three hours on it (due to a completely disastrous concept) until I finally left the computer, deleted it all, and finally did it completely differently. The original source was a nasty monster and it didn't work. This is short and functional. So if anyone wants to deal with it, it's available here.

Code: QB64: [Select]

1. 'prikaz TEXT automaticky rozdeli a vycentruje na radky dlouhy text:
2.  
3. $NoPrefix
4.  
5. T$ = "Toto je ukazka velice dlouheho textoveho retezce, ktery ma program za ukol rozdelit na nekolik kratsich retezcu a zobrazit je vycentrovane. Deleni je mozne jen v mezerach. For English-speaking friends, this notice in English: This program is designed to split extremely long text so that whole words appear on a line and do not break at the end of a line. Dividing is only possible in spaces between words."
6.  
7. Screen NewImage(1024, 768, 32)
8. f = LoadFont("arial.ttf", 25, "MONOSPACE")
9. Font f
10. Text T$
11.  
12.  
13. Sub Text (t As String)
14.     'spocitam pocet znaku na obrazovku, podle toho rozsekam retezec (v kusu o te delce najdu prvni mezeru zprava)
15.     TextMax = Width \ FontWidth
16.     Tr = 1
17.     t$ = t$ + " "
18.     Do Until LastSpace = Len(t)
19.         Word$ = Mid$(t, Tr, TextMax)
20.         LastSpace = InStrRev(Word$, " ")
21.         S$ = Mid$(Word$, 1, LastSpace)
22.         Center = Width / 2 - PrintWidth(S$) / 2
23.         PrintString (Center, y), S$
24.         y = y + FontHeight
25.         t$ = Mid$(t$, LastSpace + 1)
26.     Loop
27. End Sub
28.  

[_vince]

skvely!

[Petr]

skvely!

Thank you, _vince :)

[Petr]

Now is it centered also in Y axis:

Code: QB64: [Select]

1. 'TEXT statement automaticelly center and divide long text string on the screen. Also in Y axis now.
2.  
3. $NoPrefix
4.  
5. T$ = "For English-speaking friends, this notice in English: This program is designed to split extremely long text so that whole words appear on a line and do not break at the end of a line. Dividing is only possible in spaces between words."
6.  
7. Screen NewImage(1024, 768, 32)
8. f = LoadFont("arial.ttf", 25, "MONOSPACE")
9. Font f
10. Text T$
11.  
12.  
13. Sub Text (t As String)
14.     TextMax = Width \ FontWidth
15.     Rows = Len(t) \ TextMax
16.     y = Height / 2 - (FontHeight * Rows / 2)
17.     Tr = 1
18.     t$ = t$ + " "
19.     Do Until LastSpace = Len(t)
20.         Word$ = Mid$(t, Tr, TextMax)
21.         LastSpace = InStrRev(Word$, " ")
22.         S$ = Mid$(Word$, 1, LastSpace)
23.         Center = Width / 2 - PrintWidth(S$) / 2
24.         PrintString (Center, y), S$
25.         y = y + FontHeight
26.         t$ = Mid$(t$, LastSpace + 1)
27.     Loop
28. End Sub
29.  

[MasterGy]

I tried this out of line thing too. I think it’s important to clarify the minimum distance between 2 words and be prepared to break the word if it doesn’t fit in the line.

Code: QB64: [Select]

1. monx = 800: mony = 600 'window xy size
2.  
3. DIM SHARED txts(9), f 'txt-settings
4.  
5. txts(0) = 50 'text Y-start
6. txts(1) = 100 'left column
7. txts(2) = monx - txts(1) 'right column
8. txts(3) = 25 'font height
9. txts(4) = 20 'minimum space between words
10. txts(5) = 30 'line spacing
11.  
12. SCREEN _NEWIMAGE(monx, mony, 32): f = _LOADFONT("arial.ttf", txts(3))
13.  
14.  
15. txt "The tiger (Panthera tigris) is the largest living cat species and a member of the genus Panthera. It is most recognisable for its dark vertical stripes on orange fur with a white underside. An apex predator, it primarily preys on ungulates such as deer and wild boar. It is territorial and generally a solitary but social predator, requiring large contiguous areas of habitat, which support its requirements for prey and rearing of its offspring. Tiger cubs stay with their mother for about two years, then become independent and leave their mother's home range to establish their own."
16.  
17.  
18.  
19.  
20. SUB txt (x$)
21.     _FONT f
22.     REDIM words$(999)
23.     DO UNTIL ac > LEN(x$): ac = ac + 1
24.         a$ = MID$(x$, ac, 1)
25.         ac2 = ac
26.         DO: ac2 = ac2 + 1: LOOP WHILE MID$(x$, ac2, 1) <> " " AND ac2 < LEN(x$)
27.         a$ = MID$(x$, ac - 1, ac2 - ac + 1) '1 word
28.         FOR af = 1 TO LEN(a$): af$ = MID$(a$, af, 1) 'if a word is longer than the line, break it
29.             aw = aw + ABS(_PRINTWIDTH(words$(aw) + af$) > ABS(txts(1) - txts(2)))
30.             words$(aw) = words$(aw) + af$
31.         NEXT af
32.         aw = aw + 1
33.         ac = ac2 + 1
34.     LOOP
35.  
36.     DO UNTIL start_word > aw - 1
37.         IF words_lenght + _PRINTWIDTH(words$(start_word + words_c)) + txts(4) * words_c > ABS(txts(1) - txts(2)) THEN
38.             lastx = txts(1)
39.             words_space = (ABS(txts(1) - txts(2)) - words_lenght) / (words_c - 1)
40.             y = txts(0) + txts(5) * act_row
41.             FOR a = 0 TO words_c - 1
42.                 x = lastx
43.                 _PRINTSTRING (x, y), words$(a + start_word)
44.                 lastx = x + words_space + _PRINTWIDTH(words$(a + start_word))
45.             NEXT a
46.             start_word = start_word + words_c
47.             words_c = 0
48.             act_row = act_row + 1
49.             words_lenght = 0
50.         ELSE
51.             words_lenght = words_lenght + _PRINTWIDTH(words$(start_word + words_c))
52.             words_c = words_c + 1
53.         END IF
54.     LOOP
55. END SUB
56.  
57.  
58.  
59.  
60.  
61.  
62.  

[SMcNeill]

You might also try this little program:  https://qb64forum.alephc.xyz/index.php?topic=3592.msg129250#msg129250

Code: QB64: [Select]

1. Screen _NewImage(640, 480, 32)
2. ReDim foo(0) As String
3.  
4. text$ = "This is a bunch of foobar! "
5. For i = 1 To 10
6.     text$ = text$ + text$
7. Next
8.  
9. Calculate_WordWrap text$, 300, foo()
10. Line (301, 0)-(640, 480), &HFFFF0000, BF
11. Print UBound(foo)
12. For i = 0 To 25
13.     Print foo(i)
14. Next
15.  
16. Sleep
17.  
18. _Delay .25
19. _KeyClear
20.  
21.  
22. Cls
23.  
24. 'and now to try with a different font
25. _Font _LoadFont("courbd.ttf", 12)
26.  
27. Print "NOTE:  The next test is with a non-monospaced font, so if your PC is like mine, expect your fans to kick in, CPU usage to skyrocket, and for this process to take a few seconds."
28. Print "(We're talking 30+ seconds here, so don't think your PC has locked up if it takes that long, or longer, here.)"
29. Print
30. Print "NOTE:  This is with a NON-MONOSPACED font."
31.  
32. time## = Timer
33.  
34. Calculate_WordWrap text$, 300, foo()
35. Line (301, 0)-(640, 480), &HFFFF0000, BF
36. Print UBound(foo)
37. For i = 0 To 25
38.     Print foo(i)
39. Next
40. Print Using "###.### seconds, to be exact."; Timer - time##
41.  
42. Sleep
43.  
44. _Delay .25
45. _KeyClear
46.  
47.  
48. Cls
49. 'and now to try with a different font
50. _Font _LoadFont("courbd.ttf", 12, "monospace")
51.  
52. Print "NOTE:  This test is with the same font"
53. Print "       set as MONOSPACE, just to test"
54. Print "       the speed difference."
55. time## = Timer
56.  
57. Calculate_WordWrap text$, 300, foo()
58. Line (301, 0)-(640, 480), &HFFFF0000, BF
59. Print UBound(foo)
60. For i = 0 To 25
61.     Print foo(i)
62. Next
63. Print Using "###.### seconds, to be exact."; Timer - time##
64.  
65.  
66.  
67. Sub Calculate_WordWrap (temp$, wide%, result() As String)
68.     Dim BreakPoint As String
69.     BreakPoint = ",./- ;:!" 'I consider all these to be valid breakpoints.  If you want something else, change them.
70.  
71.     text$ = _Trim$(temp$)
72.     Do
73.         'first find the natural length of the line
74.         For i = 1 To Len(text$)
75.             p = _PrintWidth(Left$(text$, i))
76.             If p > wide% Then Exit For
77.         Next
78.         lineend = i - 1
79.         If lineend = 0 Then GoTo clean_exit
80.         t$ = RTrim$(Left$(text$, lineend)) 'at most, our line can't be any longer than what fits the screen.
81.         For i = lineend To 1 Step -1
82.             If InStr(BreakPoint, Mid$(text$, i, 1)) Then lineend = i: Exit For
83.         Next
84.         result(count) = RTrim$(Left$(text$, lineend))
85.         count = count + 1
86.         If count > UBound(result) Then ReDim _Preserve result(count + 100) As String
87.         text$ = LTrim$(Mid$(text$, lineend + 1))
88.     Loop Until text$ = ""
89.     clean_exit:
90.     ReDim _Preserve result(count) As String
91. End Sub
92.  

Convert text to a word-wrapped array().  ;)

[bplus]

Now is it centered also in Y axis:

Code: QB64: [Select]

1. 'TEXT statement automaticelly center and divide long text string on the screen. Also in Y axis now.
2.  
3. $NoPrefix
4.  
5. T$ = "For English-speaking friends, this notice in English: This program is designed to split extremely long text so that whole words appear on a line and do not break at the end of a line. Dividing is only possible in spaces between words."
6.  
7. Screen NewImage(1024, 768, 32)
8. f = LoadFont("arial.ttf", 25, "MONOSPACE")
9. Font f
10. Text T$
11.  
12.  
13. Sub Text (t As String)
14.     TextMax = Width \ FontWidth
15.     Rows = Len(t) \ TextMax
16.     y = Height / 2 - (FontHeight * Rows / 2)
17.     Tr = 1
18.     t$ = t$ + " "
19.     Do Until LastSpace = Len(t)
20.         Word$ = Mid$(t, Tr, TextMax)
21.         LastSpace = InStrRev(Word$, " ")
22.         S$ = Mid$(Word$, 1, LastSpace)
23.         Center = Width / 2 - PrintWidth(S$) / 2
24.         PrintString (Center, y), S$
25.         y = y + FontHeight
26.         t$ = Mid$(t$, LastSpace + 1)
27.     Loop
28. End Sub
29.  

@Petr I like the centering but your code fails with super long "words", fails even to include. This was MasterGy's point I think:

Code: QB64: [Select]

1. 'TEXT statement automaticelly center and divide long text string on the screen. Also in Y axis now.
2.  
3. $NoPrefix
4.  
5. T$ = "For English-speaking friends, this notice in English: This program is designed to split extremely long text so that whole words appear on a line and do not break at the end of a line. Dividing is only possible in spaces between words."
6. T$ = T$ + " Lets add some really long strings like ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890-ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890"
7. T$ = T$ + " Plus, this shorty."
8. Screen NewImage(600, 720, 32)
9. f = LoadFont("arial.ttf", 25, "MONOSPACE")
10. Font f
11. Text T$
12.  
13.  
14. Sub Text (t As String)
15.     TextMax = Width \ FontWidth
16.     Rows = Len(t) \ TextMax
17.     y = Height / 2 - (FontHeight * Rows / 2)
18.     Tr = 1
19.     t$ = t$ + " "
20.     Do Until LastSpace = Len(t)
21.         Word$ = Mid$(t, Tr, TextMax)
22.         LastSpace = InStrRev(Word$, " ")
23.         S$ = Mid$(Word$, 1, LastSpace)
24.         Center = Width / 2 - PrintWidth(S$) / 2
25.         PrintString (Center, y), S$
26.         y = y + FontHeight
27.         t$ = Mid$(t$, LastSpace + 1)
28.     Loop
29. End Sub
30.  
31.  
32.  

It just quits??

[bplus]

Steve's wordWrap holds up pretty well testing same string and font on same size screen, be nice to see centering of each line, not a hard mod after have the array of strings and could use Ubound of array to center height as well.

Code: QB64: [Select]

1. Screen _NewImage(600, 720, 32)
2. ReDim foo(0) As String
3.  
4. Text$ = "For English-speaking friends, this notice in English: This program is designed to split extremely long text so that whole words appear on a line and do not break at the end of a line. Dividing is only possible in spaces between words."
5. Text$ = Text$ + " Lets add some really long strings like ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890"
6. Text$ = Text$ + " Plus, this shorty."
7. Calculate_WordWrap Text$, 600, foo()
8. For i = 0 To UBound(foo)
9.     Print foo(i)
10. Next
11.  
12. Sleep
13.  
14. _Delay .25
15. _KeyClear
16.  
17.  
18. Cls
19.  
20. 'and now to try with a different font
21.  
22. _Font _LoadFont("arial.ttf", 25, "MONOSPACE")
23.  
24. 'Print "NOTE:  The next test is with a non-monospaced font, so if your PC is like mine, expect your fans to kick in, CPU usage to skyrocket, and for this process to take a few seconds."
25. 'Print "(We're talking 30+ seconds here, so don't think your PC has locked up if it takes that long, or longer, here.)"
26. 'Print
27. 'Print "NOTE:  This is with a NON-MONOSPACED font."
28.  
29. time## = Timer
30.  
31. Calculate_WordWrap Text$, 600, foo()
32. 'Print UBound(foo)
33. For i = 0 To UBound(foo)
34.     Print foo(i)
35. Next
36. Print Using "###.### seconds, to be exact."; Timer - time##
37.  
38. Sleep
39.  
40. '_Delay .25
41. '_KeyClear
42.  
43.  
44. 'Cls
45. ''and now to try with a different font
46. '_Font _LoadFont("courbd.ttf", 12, "monospace")
47.  
48. 'Print "NOTE:  This test is with the same font"
49. 'Print "       set as MONOSPACE, just to test"
50. 'Print "       the speed difference."
51. 'time## = Timer
52.  
53. 'Calculate_WordWrap Text$, 300, foo()
54. 'Line (301, 0)-(640, 480), &HFFFF0000, BF
55. 'Print UBound(foo)
56. 'For i = 0 To 25
57. '    Print foo(i)
58. 'Next
59. 'Print Using "###.### seconds, to be exact."; Timer - time##
60.  
61.  
62.  
63. Sub Calculate_WordWrap (temp$, wide%, result() As String)
64.     Dim BreakPoint As String
65.     BreakPoint = ",./- ;:!" 'I consider all these to be valid breakpoints.  If you want something else, change them.
66.  
67.     text$ = _Trim$(temp$)
68.     Do
69.         'first find the natural length of the line
70.         For i = 1 To Len(text$)
71.             p = _PrintWidth(Left$(text$, i))
72.             If p > wide% Then Exit For
73.         Next
74.         lineend = i - 1
75.         If lineend = 0 Then GoTo clean_exit
76.         t$ = RTrim$(Left$(text$, lineend)) 'at most, our line can't be any longer than what fits the screen.
77.         For i = lineend To 1 Step -1
78.             If InStr(BreakPoint, Mid$(text$, i, 1)) Then lineend = i: Exit For
79.         Next
80.         result(count) = RTrim$(Left$(text$, lineend))
81.         count = count + 1
82.         If count > UBound(result) Then ReDim _Preserve result(count + 100) As String
83.         text$ = LTrim$(Mid$(text$, lineend + 1))
84.     Loop Until text$ = ""
85.     clean_exit:
86.     ReDim _Preserve result(count) As String
87. End Sub
88.  
89.  
90.  

[bplus]

@MasterGy

I started a test of your code and was stuck trying to test same font and screen size as I did to the 2 others.
Seems to me a bad idea to do this part BEFORE You load the Font, what if Font Height > 25 but I like how everything would be controlled by screen size and Font dimensions, even the space between the strings.

EDIT: Strikeout section because I see what you did now with FontHeight, used it for loading the font, nice!

Oh wow! Newspaper style spacing between words:
 

[bplus]

Oh here is my test code of MasterGy wrap trying out the margins:

Code: QB64: [Select]

1. monx = 600: mony = 720 'window xy size
2.  
3. Dim Shared txts(9), f 'txt-settings
4.  
5.  
6. txts(0) = 0 'text Y-start
7. txts(1) = 50 'left column
8. txts(2) = monx - txts(1) 'right column same margin as left
9. txts(3) = 25 'font height
10. txts(4) = 10 'minimum space between words
11. txts(5) = 30 'line spacing
12.  
13. Screen _NewImage(monx, mony, 32):
14. f = _LoadFont("arial.ttf", txts(3)) ' this is not going to be "MonoSpace" test
15. Text$ = "For English-speaking friends, this notice in English: This program is designed to split extremely long text so that whole words appear on a line and do not break at the end of a line. Dividing is only possible in spaces between words."
16. Text$ = Text$ + " Lets add some really long strings like ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890"
17. Text$ = Text$ + " Plus, this shorty."
18.  
19. txt Text$
20.  
21.  
22. Sub txt (x$)
23.     _Font f
24.     ReDim words$(999)
25.     Do Until ac > Len(x$): ac = ac + 1
26.         a$ = Mid$(x$, ac, 1)
27.         ac2 = ac
28.         Do: ac2 = ac2 + 1: Loop While Mid$(x$, ac2, 1) <> " " And ac2 < Len(x$)
29.         a$ = Mid$(x$, ac - 1, ac2 - ac + 1) '1 word
30.         For af = 1 To Len(a$): af$ = Mid$(a$, af, 1) 'if a word is longer than the line, break it
31.             aw = aw + Abs(_PrintWidth(words$(aw) + af$) > Abs(txts(1) - txts(2)))
32.             words$(aw) = words$(aw) + af$
33.         Next af
34.         aw = aw + 1
35.         ac = ac2 + 1
36.     Loop
37.  
38.     Do Until start_word > aw - 1
39.         If words_lenght + _PrintWidth(words$(start_word + words_c)) + txts(4) * words_c > Abs(txts(1) - txts(2)) Then
40.             lastx = txts(1)
41.             words_space = (Abs(txts(1) - txts(2)) - words_lenght) / (words_c - 1)
42.             y = txts(0) + txts(5) * act_row
43.             For a = 0 To words_c - 1
44.                 x = lastx
45.                 _PrintString (x, y), words$(a + start_word)
46.                 lastx = x + words_space + _PrintWidth(words$(a + start_word))
47.             Next a
48.             start_word = start_word + words_c
49.             words_c = 0
50.             act_row = act_row + 1
51.             words_lenght = 0
52.         Else
53.             words_lenght = words_lenght + _PrintWidth(words$(start_word + words_c))
54.             words_c = words_c + 1
55.         End If
56.     Loop
57. End Sub
58.  

[SMcNeill]

Steve's wordWrap holds up pretty well testing same string and font on same size screen, be nice to see centering of each line, not a hard mod after have the array of strings and could use Ubound of array to center height as well.

That's one of the advantages to making it an array -- right, left, center justification is simple to do, as is scrollable text.   For example, have 25 lines of text, and only 10 lines of screen space to display them in??   No problem!  Set an input loop to use the arrow keys to increase/decrease a counter, and then display your lines starting from counter to counter + 10!

Many advantages to making the array first before displaying.  ;)

[Petr]

Thank you all for your many inspiring ideas and examples. The MasterGy solution is beautiful, the test with the Steve program took me 61 seconds, and to comment on BPlus - you're right, my program just didn't expect that there would be so many characters in the text without a space. I see that you can really improve a lot on this as well. The solution at the beginning of this thread is still sufficient for the purpose for which it was written. I will publish the exact use and the reason why I deal with it soon. It is again just one fragment from a larger program. Thank you all for your many inspiring suggestions!

[SMcNeill]

@Petr 61 seconds for a non-monospaced font.  Probably less than a second for a monospaced font.   It's a highlight of the difference in how _PRINTWIDTH calculates the two.

With monospaced fonts, printwidth can calculate width by character.  (Character count * fontwidth)  it's a quick and simple math calculation.  With non-monospaced fonts, the routine has to check and build width pixel by pixel as it goes. A "W" might spread and use 64 pixels, an "i" might use 8...  non-monospaced fonts are *much* slower to calculate print widths with, and that's something I wanted to emphasize with my demo.

I wouldn't plug in that little text to word-wrap array routine if I was using non-monospaced fonts, as I'd have to hunt for a faster, more efficient way to build and deal with those (perhaps an array with pre-calculated font character widths to work with?), but it'll work fine all the rest ofthe time.  ;)

[_vince]

With non-monospaced fonts, the routine has to check and build width pixel by pixel as it goes. A "W" might spread and use 64 pixels, an "i" might use 8...  non-monospaced fonts are *much* slower to calculate print widths with, and that's something I wanted to emphasize with my demo.

Is this a one dimensional form of OCR? the difference in aka screen 0 printing

[SMcNeill]

Is this a one dimensional form of OCR? the difference in aka screen 0 printing

Not really.  _PRINTWIDTH, from I remember, basically prints your text on a hidden blank screen 10,000 pixels wide and _FONTHEIGHT tall.  Then it starts at the 10,000th pixel and looks for a white pixel (text), instead of a black one (empty space).  When it first encounters the white pixel, it quits and returns that as a value for the printwidth.

It's a hack that works, but it's slow.  (Imagine a font 20 pixels tall, and your text is only 123 pixels in width in total...  That's 20 (pixels per vertical line) x 9877 (vertical lines) comparisons before it returns 123 as your solution.

Compared to a monospaced font which is (character count * fontwidth) in size. 

No real OCR going on anywhere; just a hunt for color on a blank background, but calculating non-monospaced text width is a slow command, as illustrated via my demo above.  If you need speed, you'll want to write your own custom width calculation routines.