The BASIC Word-wrap Challenge! (BBC BASIC)

bbc micro/electron/atom/risc os coding queries and routines
Post Reply
User avatar
lurkio
Posts: 2902
Joined: Wed Apr 10, 2013 12:30 am
Location: Doomawangara
Contact:

The BASIC Word-wrap Challenge! (BBC BASIC)

Post by lurkio » Sun May 05, 2019 6:36 pm

Adapting the Love Letters and Whitehall programs for BBC BASIC made me wonder whether any improvements could be made to the word-wrap routine I've used. (The routine prevents any word in a string of English text from being split across more than one line when printed on screen.) It turns out it's not as cut-and-dried a subject as you might think (on other platforms at least).

Of course, you can write something in assembler that runs lightning-fast, but the challenge I'm proposing here is to stick to BASIC and see if you can speed up or otherwise improve the word-wrap PROCedure that I eventually settled on. Here it is, at the end of a program that times various test-cases:

Code: Select all

   5 MODE7
  10 TIME=0:PROCp("The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog. The quick brown fox vaulted."):PRINTTIME
  20 TIME=0:PROCp("The word is aminoheptafluorocyclotetraphosphonitrile"):PRINTTIME
  30 TIME=0:PROCp("The word is aminoheptafluorocyclotetraphosphonitrile whatever that means."):PRINTTIME
  40 TIME=0:PROCp("The word is aminoheptafluorocyclotetraphosphonitrile."):PRINTTIME
  50 TIME=0:PROCp("I think I've got pneumonoultramicroscopicsilicovolcanoconiosis, whatever that is."):PRINTTIME
 100 END
2999 REM Word-wrap: l% = line length
3000 DEFPROCp(s$):LOCALn%,a%,z%,w%,l%:l%=40:n%=LENs$:a%=1:REPEATz%=INSTR(s$," ",a%):w%=z%-a%:IF(w%-1<l%ANDl%-POS<w%)OR(z%=0ANDn%-a%<l%ANDl%-POS<n%+1-a%)PRINT
3010 PRINTMID$(s$,a%,w%);:IFz%=0UNTILTRUE:PRINT:ENDPROC ELSEa%=z%+1:IFPOS>0PRINT" ";:UNTILFALSE ELSEUNTILFALSE

Run in JSBeeb:
Can you come up with a routine that handles the test-cases in the same way (or better) and is faster too? If you can, then post it in this thread, and the best new word-wrap routine will win a wrapped copy of Word.*

:?:

* Not really.

fuzzel
Posts: 660
Joined: Sun Jan 02, 2005 1:16 pm
Location: Cullercoats, North Tyneside
Contact:

Re: The BASIC Word-wrap Challenge! (BBC BASIC)

Post by fuzzel » Sun May 05, 2019 7:09 pm

A great idea Lurkio, I'll compare your version to the basic version of the assembly routine I wrote for my text adventure. I'm not too proud to incorporate your or the winning version into my adventure if it proves to be faster and less memory hungry than mine (provided I'm actually able to recode it in assembly of course). Now, about the royalties issue ....
Last edited by fuzzel on Sun May 05, 2019 7:10 pm, edited 1 time in total.

dp11
Posts: 1199
Joined: Sun Aug 12, 2012 9:47 pm
Contact:

Re: The BASIC Word-wrap Challenge! (BBC BASIC)

Post by dp11 » Sun May 05, 2019 8:12 pm

tackling the problem in a different way. You might compress the word strings to a single byte say and have a lookup table from byte to word which also contains the length of the word. This does limit you to a dictionary of 255 words with the 256th being end of string say, but you'd get smaller and fast code.

fuzzel
Posts: 660
Joined: Sun Jan 02, 2005 1:16 pm
Location: Cullercoats, North Tyneside
Contact:

Re: The BASIC Word-wrap Challenge! (BBC BASIC)

Post by fuzzel » Sun May 05, 2019 8:32 pm

Lurkio, could you post your BASIC program as an ssd file please ?
Last edited by fuzzel on Sun May 05, 2019 8:32 pm, edited 1 time in total.

User avatar
LordVaderUK
Posts: 208
Joined: Thu Jan 31, 2019 12:26 am
Location: Hampshire
Contact:

Re: The BASIC Word-wrap Challenge! (BBC BASIC)

Post by LordVaderUK » Sun May 05, 2019 10:26 pm

I am currently writing a text adventure and had to address this very issue. The routine I've come up works in any mode but is ideal for mode 7. It will also handle centering text, printing in double height, and can display in 'teletype' mode, i.e. a character at a time (beware, runs very slowly on a real BBC!)

Here's the code, feel free to use/abuse as you see fit!

Duff code removed - see correct code in later post
Last edited by LordVaderUK on Mon May 06, 2019 8:47 am, edited 1 time in total.
Loving my BBC Master 128

User avatar
lurkio
Posts: 2902
Joined: Wed Apr 10, 2013 12:30 am
Location: Doomawangara
Contact:

Re: The BASIC Word-wrap Challenge! (BBC BASIC)

Post by lurkio » Mon May 06, 2019 12:31 am

LordVaderUK wrote:
Sun May 05, 2019 10:26 pm
The routine I've come up works in any mode but is ideal for mode 7 ... Here's the code, feel free to use/abuse as you see fit!
I get a "No FN at line 500" error:

Code: Select all

   10TxtScrWidth%=40
   20PROCDisplayText("The quick brown fox jumps over the lazy dog.",135,0,0,0)
   30END
   50DEF PROCDisplayText(CS$,Clr,Cen,DblHeight,TT)
   60REM CS$ = The string you want to display, centred.  Will be split over multiple lines if necessary
   70REM Clr = Telext colour code for the txt
   80REM Cen = TRUE means line will be centred
   90REM DblHeight = TRUE will display at double height
  100REM TT = display like teletype, letter at a time
  120REPEAT
  130CS$=FNStrip(CS$) : REM remove leading or trailing spaces
  150Rpt=1
  160IF Clr <> 0 THEN CS$=CHR$(Clr)+CS$
  170IF DblHeight THEN CS$=CHR$(141)+CS$ : Rpt=2
  190TempCS$=CS$:Strlen%=LEN(CS$)
  210REM Find last space in this chunk
  220IF Strlen%>=TxtScrWidth% THEN SpcIdx%=FNFindLastSpace(CS$,TxtScrWidth%) ELSE SpcIdx%=Strlen%
  240REM Strip leading and trailing spaces on this chunk
  250CS$ = FNStrip(LEFT$(CS$, SpcIdx%))
  270FOR D% = 1 TO Rpt
  280  IF Cen PRINT STRING$((TxtScrWidth% - LEN(CS$))/2," ");
  290  IF TT FOR TT%=1 TO LEN(CS$):PRINT MID$(CS$,TT%,1);:X=INKEY(0):NEXT TT%:PRINT
  300  IF NOT TT PRINT CS$
  310NEXT D%
  330REM Chop out the bit we've already printed
  340CS$=MID$(TempCS$, SpcIdx%, Strlen% - SpcIdx% + 1)
  360UNTIL Strlen%<TxtScrWidth%
  370ENDPROC
  390DEF FNFindLastSpace(CS$,W%)
  400SpcIdx% = W%
  410REPEAT
  420SP$=MID$(CS$,SpcIdx%,1)
  430IF SP$<>" "SpcIdx%=SpcIdx%-1
  440UNTILSP$=" "ORSpcIdx%=0
  450=SpcIdx%
  470DEF FNStrip(STRIP$)
  480REPEAT:L$=LEFT$(STRIP$,1):IFL$=" "STRIP$=RIGHT$(STRIP$,LEN(STRIP$)-1):UNTIL L$<>" "
  490REPEAT:R$=RIGHT$(STRIP$,1):IFR$=" "STRIP$=LEFT$(STRIP$,LEN(STRIP$)-1):UNTIL R$<>" "
  500=STRIP$
:?:

User avatar
LordVaderUK
Posts: 208
Joined: Thu Jan 31, 2019 12:26 am
Location: Hampshire
Contact:

Re: The BASIC Word-wrap Challenge! (BBC BASIC)

Post by LordVaderUK » Mon May 06, 2019 8:46 am

How embarrassing :oops:

It worked fine on the BBC BASIC emulator but crashes out on BeebEm (and I assume other less forgiving emulators!) It was down to my clumsy efforts to put the strip code onto a single line with an IF statement in the middle. By breaking them into separate lines it works now...

SEE POST BELOW FOR FINAL CODE
Last edited by LordVaderUK on Mon May 06, 2019 2:29 pm, edited 1 time in total.
Loving my BBC Master 128

User avatar
jgharston
Posts: 4119
Joined: Thu Sep 24, 2009 12:22 pm
Location: Whitby/Sheffield
Contact:

Re: The BASIC Word-wrap Challenge! (BBC BASIC)

Post by jgharston » Mon May 06, 2019 2:15 pm

You've got the IF and REPEAT the wrong way around, so leaving an unbalanced REPEAT on the stack, it should be:
DEFFNs(A$)
IF LEFT$(A$,1)=" ":REPEAT A$=MID$(A$,2):UNTIL LEFT$(A$,1)<>" "
IF RIGHT$(A$,1)=" ":REPEAT A$=LEFT$(A$,LENA$-1):UNTIL RIGHT$(A$,1)<>" "
=A$

I haven't looked at the code upthread yet, but the naive method of wordwrapping is to look for the next space and print each word one at a time, checking if the next word would wrap. So, "the" spc "quick" spc "brown" etc.

The less-naive is to start at the current point plus the width of the screen and search /backwards/ for a space, and print all that in one go, then start at that point again. So, "The quick brown fox" nl "jumps over the lazy" nl "dog" etc.

Code: Select all

$ bbcbasic
PDP11 BBC BASIC IV Version 0.32
(C) Copyright J.G.Harston 1989,2005-2020
>_

User avatar
LordVaderUK
Posts: 208
Joined: Thu Jan 31, 2019 12:26 am
Location: Hampshire
Contact:

Re: The BASIC Word-wrap Challenge! (BBC BASIC)

Post by LordVaderUK » Mon May 06, 2019 2:26 pm

Thanks jgharston, that explains it! Correct code, with single line REPEATS, is below...

Code: Select all

   10 TxtScrWidth%=40
   20 REPEAT
   30   INPUT "Enter text",T$
   40   IF T$="" T$="The quick brown fox jumps over the lazy dog."
   50   PROCDisplayText(T$,135,0,0,0)
   60 UNTIL FALSE
   70 END
   80 DEF PROCDisplayText(CS$,Clr,Cen,DblHeight,TT)
   90 REM CS$ = The string you want to display, centred.  Will be split over multiple lines if necessary
  100 REM Clr = Telext colour code for the txt
  110 REM Cen = TRUE means line will be centred
  120 REM DblHeight = TRUE will display at double height
  130 REM TT = display like teletype, letter at a time
  140 REPEAT
  150   CS$=FNStrip(CS$) : REM remove leading or trailing spaces
  160   Rpt=1
  170   IF Clr <> 0 THEN CS$=CHR$(Clr)+CS$
  180   IF DblHeight THEN CS$=CHR$(141)+CS$ : Rpt=2
  190   TempCS$=CS$:Strlen%=LEN(CS$)
  200   REM Find last space in this chunk
  210   IF Strlen%>=TxtScrWidth% THEN SpcIdx%=FNFindLastSpace(CS$,TxtScrWidth%) ELSE SpcIdx%=Strlen%
  220   REM Strip leading and trailing spaces on this chunk
  230   CS$=LEFT$(CS$, SpcIdx%)
  240   CS$ = FNStrip(CS$)
  250   FOR D% = 1 TO Rpt
  260     IF Cen PRINT STRING$((TxtScrWidth% - LEN(CS$))/2," ");
  270     IF TT FOR TT%=1 TO LEN(CS$):PRINT MID$(CS$,TT%,1);:X=INKEY(0):NEXT TT%:PRINT
  280     IF NOT TT PRINT CS$
  290   NEXT D%
  300   REM Chop out the bit we've already printed
  310   CS$=MID$(TempCS$, SpcIdx%, Strlen% - SpcIdx% + 1)
  320 UNTIL Strlen%<TxtScrWidth%
  330 ENDPROC
  340
  350 DEF FNFindLastSpace(CS$,W%)
  360 SpcIdx% = W%
  370 REPEAT
  380   SP$=MID$(CS$,SpcIdx%,1)
  390   IF SP$<>" "SpcIdx%=SpcIdx%-1
  400 UNTILSP$=" "ORSpcIdx%=0
  410 =SpcIdx%
  420
  430 DEF FNStrip(STRIP$)
  440 IF LEFT$(STRIP$,1)=" ":REPEAT:STRIP$=RIGHT$(STRIP$,LEN(STRIP$)-1):UNTIL LEFT$(STRIP$,1)<>" "
  450 IF RIGHT$(STRIP$,1)=" ":REPEAT:STRIP$=LEFT$(STRIP$,LEN(STRIP$)-1):UNTIL RIGHT$(STRIP$,1)<>" "
  460 =STRIP$
What this code can't cope with though is a word which is too long for the width of the screen. I might have a go at fixing that, but obviously for my purposes, an adventure program, I am in control of all the text so I won't ever have a word which is longer than the screen width.

PS: my code uses method two ;-)
Last edited by LordVaderUK on Mon May 06, 2019 2:29 pm, edited 2 times in total.
Loving my BBC Master 128

User avatar
scruss
Posts: 275
Joined: Sun Jul 01, 2018 4:12 pm
Location: Toronto
Contact:

Re: The BASIC Word-wrap Challenge! (BBC BASIC)

Post by scruss » Mon May 06, 2019 2:40 pm

LordVaderUK wrote:
Mon May 06, 2019 2:26 pm
What this code can't cope with though is a word which is too long for the width of the screen. I might have a go at fixing that, but obviously for my purposes, an adventure program, I am in control of all the text so I won't ever have a word which is longer than the screen width.
It's not set in Llanfair­pwllgwyngyll­gogery­chwyrn­drobwll­llan­tysilio­gogo­goch, then? :)

I'd recommend skipping even looking at hyphenation. It's a bigger problem than would be remotely practical in BBC BASIC. There are numerous PhD papers on H&J (hyphenation and justification) and there's really no way to do it without a large dictionary of exceptions.

User avatar
LordVaderUK
Posts: 208
Joined: Thu Jan 31, 2019 12:26 am
Location: Hampshire
Contact:

Re: The BASIC Word-wrap Challenge! (BBC BASIC)

Post by LordVaderUK » Mon May 06, 2019 7:42 pm

scruss wrote:
Mon May 06, 2019 2:40 pm
LordVaderUK wrote:
Mon May 06, 2019 2:26 pm
What this code can't cope with though is a word which is too long for the width of the screen. I might have a go at fixing that, but obviously for my purposes, an adventure program, I am in control of all the text so I won't ever have a word which is longer than the screen width.
It's not set in Llanfair­pwllgwyngyll­gogery­chwyrn­drobwll­llan­tysilio­gogo­goch, then? :)

I'd recommend skipping even looking at hyphenation. It's a bigger problem than would be remotely practical in BBC BASIC. There are numerous PhD papers on H&J (hyphenation and justification) and there's really no way to do it without a large dictionary of exceptions.
Yeah I have no intention of trying to fix it. It'd just be an example of pointless over-engineering!
Loving my BBC Master 128

User avatar
lurkio
Posts: 2902
Joined: Wed Apr 10, 2013 12:30 am
Location: Doomawangara
Contact:

Re: The BASIC Word-wrap Challenge! (BBC BASIC)

Post by lurkio » Mon May 06, 2019 8:53 pm

I have to admit that one of the things I like about my earlier "look-ahead" routine* is that it consists of just two lines of BASIC. Plus, it handles overlong words fairly well, or as well as a short routine can -- certainly better than this "backtracking" routine** I've now come up with:

Code: Select all

 10 MODE7:PRINT
 20 TIME=0:PROCp("The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog. The quick brown fox vaulted."):PRINTTIME
 30 TIME=0:PROCp("The word is aminoheptafluorocyclotetraphosphonitrile"):PRINTTIME
 40 TIME=0:PROCp("The word is aminoheptafluorocyclotetraphosphonitrile whatever that means."):PRINTTIME
 50 TIME=0:PROCp("The word is aminoheptafluorocyclotetraphosphonitrile."):PRINTTIME
 60 TIME=0:PROCp("I think I've got pneumonoultramicroscopicsilicovolcanoconiosis, whatever that is."):PRINTTIME
 70 END
100 DEFPROCp(s$):LOCALa%,z%,l%:l%=40:n%=LENs$:a%=1:z%=l%+1-POS:REPEATIFz%>n%+1z%=n%+1ELSEREPEATz%=z%-1:UNTILMID$(s$,z%,1)=" ":IFz%<a%z%=a%+l%+1
110 PRINTMID$(s$,a%,z%-a%);:IFz%-a%<l%PRINTELSEIFMID$(s$,z%,1)=" "a%=a%+1ELSEz%=z%-1
120 a%=z%+1:z%=a%+l%+1:UNTILa%>n%:IFPOS>0PRINT:ENDPROC ELSEENDPROC

Run the program in JSBeeb:

Interestingly (if you care about such things), the backtracker is quicker than the look-ahead routine when printing shortish words, but slower when printing overlong words.

:idea:

* Which used an algorithm that JGH calls "naive".

** What JGH calls "less-naive".
Last edited by lurkio on Sat May 11, 2019 9:17 pm, edited 2 times in total.

User avatar
lurkio
Posts: 2902
Joined: Wed Apr 10, 2013 12:30 am
Location: Doomawangara
Contact:

Re: The BASIC Word-wrap Challenge! (BBC BASIC)

Post by lurkio » Tue Aug 04, 2020 2:30 pm

lurkio wrote:
Mon May 06, 2019 8:53 pm
... this "backtracking" routine** I've now come up with ...
Inspired by a comment in another thread about avoiding string functions (in this case, MID$), I've come up with a faster version of the BASIC backtracking word-wrap routine:

Code: Select all

 10 MODE7:L%=40:DIM S% 255
 
 20 TIME=0
 30 PROCp("Lorem ipsum dolor sit amet, consectetur adipiscing elit. Cras tincidunt convallis dui, congue accumsan justo commodo quis. Nunc in congue metus. Suspendisse ullamcorper augue a diam fringilla laoreet. Donec pulvinar augue")
 40 PROCp("vulputate aliquam cursus. Nulla porttitor tellus id dignissim pellentesque. Aenean sed imperdiet dolor. Fusce sagittis metus in mauris eleifend sodales. Nulla quis dictum dui. In vel nisl dignissim, laoreet quam non,")
 50 PROCp("maximus mauris. Vestibulum lobortis sollicitudin diam quis condimentum. Aliquam non posuere felis. Proin elementum tempus ipsum, et volutpat tellus interdum nec.")
 70 PRINTTIME:*FX15

100 IFGET:TIME=0
110 PROCp2("Lorem ipsum dolor sit amet, consectetur adipiscing elit. Cras tincidunt convallis dui, congue accumsan justo commodo quis. Nunc in congue metus. Suspendisse ullamcorper augue a diam fringilla laoreet. Donec pulvinar augue")
120 PROCp2("vulputate aliquam cursus. Nulla porttitor tellus id dignissim pellentesque. Aenean sed imperdiet dolor. Fusce sagittis metus in mauris eleifend sodales. Nulla quis dictum dui. In vel nisl dignissim, laoreet quam non,")
130 PROCp2("maximus mauris. Vestibulum lobortis sollicitudin diam quis condimentum. Aliquam non posuere felis. Proin elementum tempus ipsum, et volutpat tellus interdum nec.")
150 PRINTTIME:*FX15

180 IFGET:TIME=0
190 PRINT"Lorem ipsum dolor sit amet, consectetur"'"adipiscing elit. Cras tincidunt"'"convallis dui, congue accumsan justo"'"commodo quis. Nunc in congue metus."'"Suspendisse ullamcorper augue a diam"
200 PRINT"fringilla laoreet. Donec pulvinar augue"'"vulputate aliquam cursus. Nulla"'"porttitor tellus id dignissim"'"pellentesque. Aenean sed imperdiet"'"dolor. Fusce sagittis metus in mauris"
210 PRINT"eleifend sodales. Nulla quis dictum dui.";"In vel nisl dignissim, laoreet quam non,";"maximus mauris. Vestibulum lobortis"'"sollicitudin diam quis condimentum."'"Aliquam non posuere felis. Proin"
220 PRINT"elementum tempus ipsum, et volutpat"'"tellus interdum nec."
230 PRINTTIME
240 END

260 REM Word-wrap
270 DEFPROCp(s$):LOCALA%,Z%,M%,c$,N%:M%=L%:N%=LENs$:A%=1:Z%=M%+2-POS:REPEATIFZ%>N%+1Z%=N%+1ELSEREPEATZ%=Z%-1:c$=MID$(s$,Z%,1):UNTILc$=" ":IFZ%<A%Z%=A%+M%+1
280 PRINTMID$(s$,A%,Z%-A%);:VDU32,-8*(POS=1):IFZ%-A%<=M%ANDPOS PRINTELSEIFc$=" "A%=A%+1ELSEZ%=Z%-1
290 A%=Z%+1:Z%=A%+M%+1:UNTILA%>N%:IFPOS PRINT:ENDPROC ELSEENDPROC

310 DEFPROCp2($S%):LOCALA%,Z%,M%,C%,N%,T%:M%=L%:N%=LEN$S%:A%=0:Z%=M%+1-POS:REPEATIFZ%>N%Z%=N%ELSEREPEATZ%=Z%-1:C%=S%?Z%:UNTILC%=32:IFZ%<A%Z%=A%+M%
320 T%=S%?Z%:S%?Z%=13:PRINT$(S%+A%);:S%?Z%=T%:VDU32,-8*(POS=1):IFZ%-A%<=M%ANDPOS PRINTELSEIFC%=32A%=A%+1ELSEZ%=Z%-1
330 A%=Z%+1:Z%=A%+M%+1:UNTILA%>=N%:IFPOS PRINT:ENDPROC ELSEENDPROC

Run in JSBeeb

:idea:

Post Reply

Return to “programming”