**************************************************************************
      *  DBG040R3: Format text lines - with limited word wrapping.
      * Copyright (C) 2000  Martin Rowe   <martin@dbg400.net>
      *
      * This program is free software; you can redistribute it and/or modify
      * it under the terms of the GNU General Public License as published by
      * the Free Software Foundation; either version 2 of the License, or
      * (at your option) any later version.
      *
      * This program is distributed in the hope that it will be useful,
      * but WITHOUT ANY WARRANTY; without even the implied warranty of
      * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      * GNU General Public License for more details.
      *
      * You should have received a copy of the GNU General Public License
      * along with this program; if not, write to the Free Software Foundation,
      * Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
      **************************************************************************
      *  DBG040R3 will convert 1 or more lines of x characters to 1 or more
      *  lines of y characters. The resultant lines are word wrapped where
      *  possible. It is intended for use where the original text was entered in
      *  a different length to that required for display. For example, lines of
      *  50 characters will need to be reformated before displaying as lines of
      *  40. The two arrays will need to be defined in any calling pgm.
      **************************************************************************
      *  Input text 50 lines of upto 132 characters
     E                    P#I        50132
      *  Output text 50 lines of upto 132 characters
     E                    P#O        50132
      **************************************************************************
      *  DATA STRUCTURES
      **************************************************************************
      *  Input data in chunks of entry length
     ISTRING      DS                           6600
      **************************************************************************
      *  ENTRY PARAMETERS
      **************************************************************************
     C           *ENTRY    PLIST
     C                     PARM           P#TENT  30       Text entries
     C                     PARM           P#ELEN  30       Entry length
     C                     PARM           P#I              Entry data
     C                     PARM           P#FLEN  30       Format to length
     C                     PARM           P#RENT  30       Returned entries
     C                     PARM           P#O              Returned data
      **************************************************************************
      * MAINLINE PROGRAM
      **************************************************************************
      *  Field initialisation
     C                     Z-ADD0         #A      50       No of input entries
     C                     Z-ADD1         #B      50       actual text length
     C                     Z-ADD0         #C      50       trailing blanks
     C                     Z-ADD0         #D      50       leading blanks
     C                     Z-ADD1         #E      50       format length pointer
     C                     Z-ADD0         #F      50       No of output entries
     C                     Z-ADD0         #G      50       No of ' ' separators
     C                     Z-ADDP#ELEN    #L      50       Entry string length
     C                     Z-ADD0         W#LEN   50       Length of data req'd
     C                     Z-ADD0         W#DROP  50       Len of data to drop
     C                     MOVE *BLANKS   W#RDTA132        return entry line
     C                     MOVE *ON       REPEAT  1
     C                     MOVE *OFF      NOMORE  1
     C                     MOVE *BLANKS   TESTER  1
     C                     CLEARSTRING                     formatted text string
     C                     CLEARP#O                        Returned data
      *  Concatenate all the array entries into one field
B001 C           1         DO   P#TENT    #A
      *  Add the text in with a spacing blank if required
     C                     CAT  P#I,#A:#G STRING
     C           1         SUBSTP#I,#A:#L TESTER
B002 C           TESTER    IFEQ ' '
     C                     Z-ADD1         #G
X002 C                     ELSE
     C                     Z-ADD0         #G
E002 C                     ENDIF
E001 C                     ENDDO
      *  Split the resultant string into strings of the required length
B001 C           1         DO   50        #F
      *  Quit if no more to process
B002 C           NOMORE    IFEQ *ON
     C                     LEAVE
E002 C                     ENDIF
      *  Start of next string is start of current string + return length
     C           P#FLEN    ADD  #B        #C
      *  Get first character of next string
     C           1         SUBSTSTRING:#C TESTER
      *  If it's blank, then all return length of current string will fit
B002 C           TESTER    IFEQ ' '
     C           P#FLEN    SUBSTSTRING:#B W#RDTA
      *  Reset start position to next non-blank character
     C           ' '       CHECKSTRING:#C #B             70
      *  If non-blank not found, we can leave now
B003 C           *IN70     IFEQ *OFF
     C                     MOVE *ON       NOMORE
E003 C                     ENDIF
      *  Otherwise need to extract to last blank within return length
X002 C                     ELSE
      *  Set pointer for end of next portion to check
     C                     SUB  1         #C
     C                     Z-ADD#C        #E
     C                     MOVE *ON       REPEAT
      *  Check back through the current string to find a blank
B003 C           REPEAT    DOUEQ*OFF
     C           ' '       CHEKRSTRING:#C #D             70
      *
B004 C                     SELEC
      *  When pointer set before check position, (skipped over one or more
      *  blanks) we've got our our end position
S004 C           #D        WHLT #C
     C                     MOVE *OFF      REPEAT
      *  Calculate the length of string that needs to be extracted
     C           #E        SUB  #D        W#DROP           length to drop
     C           P#FLEN    SUB  W#DROP    W#LEN            required length
     C           W#LEN     SUBSTSTRING:#B W#RDTA           extract data portion
      *  Reset start position to next non-blank character
     C           ' '       CHECKSTRING:#C #B             70
      *  If non-blank not found, we can leave now
B005 C           *IN70     IFEQ *OFF
     C                     MOVE *ON       NOMORE
     C                     LEAVE
E005 C                     ENDIF
      *  When pointer at start of current string, then no blanks were found and
      *  the whole string will need to be used 'as is'
S004 C           #D        WHEQ #B
     C                     MOVE *OFF      REPEAT
     C           P#FLEN    SUBSTSTRING:#B W#RDTA
      *  Reset start postionn to next non-blank character
     C                     ADD  1         #E
     C           ' '       CHECKSTRING:#E #B             70
      *  If non-blank not found, we can leave now
B005 C           *IN70     IFEQ *OFF
     C                     MOVE *ON       NOMORE
     C                     LEAVE
E005 C                     ENDIF
      *  Otherwise start check from one position earlier in string
S004 C                     OTHER
     C                     SUB  1         #C
E004 C                     ENDSL
      *
E003 C                     ENDDO
E002 C                     ENDIF
      *
     C                     MOVELW#RDTA    P#O,#F
     C                     CLEARW#RDTA
      *  Set up final number of return entries
     C                     Z-ADD#F        P#RENT
E001 C                     ENDDO
      *
     C                     SETON                     LR
     C                     RETRN
      **************************************************************************