'===========================================================================
' Subject: LINE WRAPPING                      Date: 09-20-92 (19:57)       
'  Author: John White/Dan Bridges             Code: QB, QBasic, PDS        
'  Origin: FidoNet QUIK_BAS Echo            Packet: TEXT.ABC
'===========================================================================
' WRAPLINE.BAS, Public Domain, John White 1:3636/2, 09-09-92
' With additions by Dan Bridges 3:640/820.2 @Fidonet, 20-Sep-92
' StrLen =  Maximum length of each line
' StrIn$ = The string to parse
' Work$  = Temp variable for parsing
' WorkPlus$ = Used to ensure that words aren't split
' ParsedLines$() = Array holding the parsed strings
' NumOfLines = Maximum number of parsed strings in ParsedLines$()
' GoNoLower = Ensures that line length is bigger than biggest word
'======================================================================

DEFINT A-Z
DECLARE FUNCTION MaxWordLen (StrIn$)
DECLARE SUB WrapLine (StrLen, StrIn$, ParsedLines$(), NumOfLines)
DECLARE SUB DisplayArray (ParsedLines$(), NumOfLines, StrLen)
DECLARE SUB VaryLineLength (GoNoLower, StrLen, StrIn$, ParsedLines$(), NumOfLines)

StrLen = 40

DIM ParsedLines$(255)

CONST False = 0, True = NOT False

StrIn$ = "This is a very, very, very, long line and I think it will never end. Then again: it eventually must."

GoNoLower = MaxWordLen(StrIn$)

CLS

CALL WrapLine(StrLen, StrIn$, ParsedLines$(), NumOfLines)
CALL DisplayArray(ParsedLines$(), NumOfLines, StrLen)
CALL VaryLineLength(GoNoLower, StrLen, StrIn$, ParsedLines$(), NumOfLines)

END

SUB DisplayArray (ParsedLines$(), NumOfLines, StrLen)

CLS

IF NumOfLines = 0 THEN
  PRINT "No Data in StrIn$"
  END
END IF

COLOR 15, 0
PRINT LEFT$("....x....1....x....2....x....3....x....4....x....5....x....6....x....7....x....8", StrLen)
' Replace "x"s above with Alt-254 characters (small block).
' High ASCII characters replaced for Fidonet transmission.
COLOR 7, 0

FOR LineNum = 1 TO NumOfLines
  PRINT ParsedLines$(LineNum)
NEXT LineNum

NumOfLines = 0

END SUB

FUNCTION MaxWordLen (StrIn$)

  StrIn$ = LTRIM$(RTRIM$(StrIn$))

  IF INSTR(StrIn$, " ") = 0 THEN
    MaxWordLen = LEN(StrIn$)
    EXIT FUNCTION
  END IF

  Space1 = INSTR(StrIn$, " ")

  DO
    Space2 = INSTR(Space1 + 1, StrIn$, " ")

    IF Space2 = 0 THEN
      WordLen = LEN(StrIn$) - Space1
    ELSE
      WordLen = Space2 - Space1 - 1
    END IF

    IF WordLen > TempMaxLen THEN TempMaxLen = WordLen
    Space1 = Space2
  LOOP WHILE Space2

    MaxWordLen = TempMaxLen

END FUNCTION

SUB VaryLineLength (GoNoLower, StrLen, StrIn$, ParsedLines$(), NumOfLines)

DO
  SELECT CASE INKEY$

  CASE CHR$(45)  'Action if Grey Minus Key is pressed
    IF StrLen = GoNoLower THEN
      LOCATE 24, 9: BEEP
      PRINT "Requested Right Margin is less than the length of the longest word."
      LOCATE 25, 9
      PRINT "Margin reduction command ignored! Press any key to clear this message...";
      DO: LOOP WHILE INKEY$ = ""
      CLS
    ELSE
      StrLen = StrLen - 1
    END IF
    CALL WrapLine(StrLen, StrIn$, ParsedLines$(), NumOfLines)
    CALL DisplayArray(ParsedLines$(), NumOfLines, StrLen)

  CASE CHR$(43)  'Action if Grey Plus Key is pressed
    IF StrLen = 80 THEN
      LOCATE 24, 9: BEEP
      PRINT "Requested Right Margin is greater than 80 characters.";
      LOCATE 25, 9
      PRINT "Margin expansion command ignored! Press any key to clear this message...";
      DO: LOOP WHILE INKEY$ = ""
      CLS
    ELSE
      StrLen = StrLen + 1
    END IF
    CALL WrapLine(StrLen, StrIn$, ParsedLines$(), NumOfLines)
    CALL DisplayArray(ParsedLines$(), NumOfLines, StrLen)

  CASE CHR$(27)  'Action if Esc Key is pressed
    EXIT DO

  END SELECT
LOOP

END SUB

SUB WrapLine (StrLen, StrIn$, ParsedLines$(), NumOfLines)

  IF StrIn$ = "" THEN
    NumOfLines = 0
    EXIT SUB
  END IF
  'If string to split is nothing, exit.

  Work$ = StrIn$                     'Keep original value in StrIn$
  Done = False                       'reset flag

  DO
    IF LEN(Work$) > StrLen THEN
      NumOfLines = NumOfLines + 1    'Increment index to array
      WorkPlus$ = LEFT$(Work$, StrLen + 1)
      'WorkPlus$ is used to see if there is a space immediately
      'after the requested split point so we do not split a word.

      FOR SearchStartPos = StrLen TO 1 STEP -1
        LastSpacePos = INSTR(SearchStartPos, WorkPlus$, " ")
        IF LastSpacePos THEN
          ParsedLines$(NumOfLines) = LTRIM$(RTRIM$(LEFT$(Work$, LastSpacePos)))  'Put left (StrLen) chars in array
          Work$ = MID$(Work$, SearchStartPos + 1)
          'Remove parsed segment from Work$
          EXIT FOR
        END IF
      NEXT SearchStartPos

    ELSE
      Done = True
    END IF
  LOOP UNTIL Done

  NumOfLines = NumOfLines + 1   'Save remainder of StrIn$
  ParsedLines$(NumOfLines) = LTRIM$(Work$)

END SUB