SUBROUTINE QFOLD (FOLD.FLD,FOLD.WID,PRSE.DLM,FOLD.OUT)
**BASIC
**01-01-08 11:52:48
**07/18/84
**TOM PHILLIPS
**www.tom-phillips.info
**Copyright 2008 by SQUASH. All rights reserved.
*
* QFOLD - FOLD A TEXT STRING INTO A SPECIFIED WIDTH
*        (FOLD.FLD IS THE VARIABLE TO "FOLD")
*        (FOLD.WID IS THE FOLDING WIDTH)
*        (PRSE.DLM IS THE PARSING DELIMITER)
*        (FOLD.OUT IS AN ATTRIBUTE DELIMITED VARIABLE)
*
*EQU AM TO @AM;* NORMALLY CHAR(254)
*EQU VM TO @VM;* NORMALLY CHAR(253)
*EQU SM TO @SM;* NORMALLY CHAR(252)
EQU AM TO CHAR(254)
EQU VM TO CHAR(253)
EQU SM TO CHAR(252)
*
FOLD.TXT=''
FOLD.OUT=''
FOLD.DLM=''
LAST.AMC=DCOUNT(FOLD.FLD,AM)
FOR FOLD.AMC=1 TO LAST.AMC
 LAST.VMC=DCOUNT(FOLD.FLD<FOLD.AMC>,VM)
 FOR FOLD.VMC=1 TO LAST.VMC
  LAST.SVC=DCOUNT(FOLD.FLD<FOLD.AMC,FOLD.VMC>,SM)
  FOR FOLD.SVC=1 TO LAST.SVC
   FOLD.TXT=FOLD.TXT:FOLD.DLM:FOLD.FLD<FOLD.AMC,FOLD.VMC,FOLD.SVC>
   FOLD.DLM=PRSE.DLM
  NEXT FOLD.SVC
 NEXT FOLD.VMC
NEXT FOLD.AMC
FOLD.LEN=LEN(FOLD.TXT)
IF NOT(FOLD.LEN) THEN RETURN
*
FOLD.AMC=0
FOLD.LIN=''
FOLD.DLM=''
FOLD.LMT=DCOUNT(FOLD.TXT,PRSE.DLM)
FOR FOLD.CTR=1 TO FOLD.LMT
 FOLD.FLD=FIELD(FOLD.TXT,PRSE.DLM,FOLD.CTR)
 FOLD.LEN=LEN(FOLD.FLD)
 TEST.LEN=LEN(FOLD.LIN)+FOLD.LEN+LEN(FOLD.DLM)
 BEGIN CASE
  CASE FOLD.LEN>FOLD.WID
   IF FOLD.LIN#'' THEN GOSUB 2001
   GOSUB 1001
   GOSUB 2001
  CASE TEST.LEN>FOLD.WID
   IF FOLD.LIN#'' THEN GOSUB 2001
   FOLD.LIN=FOLD.LIN:FOLD.DLM:FOLD.FLD
   FOLD.DLM=PRSE.DLM
  CASE 1
   FOLD.LIN=FOLD.LIN:FOLD.DLM:FOLD.FLD
   FOLD.DLM=PRSE.DLM
 END CASE
NEXT FOLD.CTR
IF FOLD.LIN#'' THEN GOSUB 2001
RETURN
*
******
1001 *
******
TEMP.END=0
TEMP.POS=1
TEMP.AMC=0
TEMP.LMT=LEN(FOLD.FLD)
LOOP
 TEMP.AMC=TEMP.AMC+1
 FOLD.LIN<TEMP.AMC>=FOLD.FLD[TEMP.POS,FOLD.WID]
 TEMP.POS=TEMP.POS+FOLD.WID
 IF TEMP.POS>TEMP.LMT THEN TEMP.END=1
UNTIL (TEMP.END) DO
REPEAT
RETURN
*
******
2001 *
******
MOVE.LMT=DCOUNT(FOLD.LIN,AM)
FOR MOVE.AMC=1 TO MOVE.LMT
 MOVE.LIN=FOLD.LIN<MOVE.AMC>
 IF MOVE.LIN#'' THEN
  FOLD.AMC=FOLD.AMC+1
  FOLD.OUT<FOLD.AMC>=MOVE.LIN
 END
NEXT MOVE.AMC
FOLD.LIN=''
FOLD.DLM=''
RETURN
*
END