Author Topic: Text to Word Wrap Array  (Read 3792 times)

0 Members and 1 Guest are viewing this topic.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Text to Word Wrap Array
« on: February 03, 2021, 12:32:25 am »
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.  
  8. Calculate_WordWrap text$, 300, foo()
  9. LINE (301, 0)-(640, 480), &HFFFF0000, BF
  10. FOR i = 0 TO 25
  11.     PRINT foo(i)
  12.  
  13.  
  14. _DELAY .25
  15.  
  16.  
  17.  
  18. 'and now to try with a different font
  19. _FONT _LOADFONT("courbd.ttf", 12)
  20.  
  21. 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."
  22. time## = TIMER
  23.  
  24. Calculate_WordWrap text$, 300, foo()
  25. LINE (301, 0)-(640, 480), &HFFFF0000, BF
  26. FOR i = 0 TO 25
  27.     PRINT foo(i)
  28. PRINT USING "###.### seconds, to be exact."; TIMER - time##
  29.  
  30.  
  31. _DELAY .25
  32.  
  33.  
  34. 'and now to try with a different font
  35. _FONT _LOADFONT("courbd.ttf", 12, "monospace")
  36.  
  37. PRINT "NOTE:  This test is with the same font"
  38. PRINT "       set as MONOSPACE, just to test"
  39. PRINT "       the speed difference."
  40. time## = TIMER
  41.  
  42. Calculate_WordWrap text$, 300, foo()
  43. LINE (301, 0)-(640, 480), &HFFFF0000, BF
  44. FOR i = 0 TO 25
  45.     PRINT foo(i)
  46. PRINT USING "###.### seconds, to be exact."; TIMER - time##
  47.  
  48.  
  49.  
  50. SUB Calculate_WordWrap (temp$, wide%, result() AS STRING)
  51.     DIM BreakPoint AS STRING
  52.     BreakPoint = ",./- ;:!" 'I consider all these to be valid breakpoints.  If you want something else, change them.
  53.  
  54.     text$ = _TRIM$(temp$)
  55.     DO
  56.         'first find the natural length of the line
  57.         FOR i = 1 TO LEN(text$)
  58.             p = _PRINTWIDTH(LEFT$(text$, i))
  59.             IF p > wide% THEN EXIT FOR
  60.         NEXT
  61.         lineend = i - 1
  62.         IF lineend = 0 THEN GOTO clean_exit
  63.         t$ = RTRIM$(LEFT$(text$, lineend)) 'at most, our line can't be any longer than what fits the screen.
  64.         FOR i = lineend TO 1 STEP -1
  65.             IF INSTR(BreakPoint, MID$(text$, i, 1)) THEN lineend = i: EXIT FOR
  66.         NEXT
  67.         result(count) = RTRIM$(LEFT$(text$, lineend))
  68.         count = count + 1
  69.         IF count > UBOUND(result) THEN REDIM _PRESERVE result(count + 100) AS STRING
  70.         text$ = LTRIM$(MID$(text$, lineend + 1))
  71.     LOOP UNTIL text$ = ""
  72.     clean_exit:
  73.     REDIM _PRESERVE result(count) AS STRING

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.
« Last Edit: February 03, 2021, 12:34:52 am by SMcNeill »
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!