Text to Word Wrap Array

[SMcNeill]

Something which I'm needing for a current project of mine, and I thought I'd share, in case anyone else might ever have use for it.

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:  This 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. time## = TIMER
29.  
30. Calculate_WordWrap text$, 300, foo()
31. LINE (301, 0)-(640, 480), &HFFFF0000, BF
32. PRINT UBOUND(foo)
33. FOR i = 0 TO 25
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

Usage is rather simple:

1) REDIM and array AS STRING

REDIM foo(0) AS STRING

2) Call the routine with the text you want wrapped, the size you want the wrapping to fit in, and then the array to store the wrapped text in.

Calculate_WordWrap text$, 300, foo()

That's all there is to it!  ;)

Enjoy, test it out, and let me know if you manage to break it with something odd, and I'll correct whatever the glitch is ASAP.


EDIT:  Make certain your desired font is set before calling, as it works with whatever you currently are using.  This does nothing to allow on the fly font changes.  I kept it more or less as simple as possible.