'===========================================================================
' Subject: WORD WRAP WITH JUSTIFICATION Date: 02-27-98 (00:57)
' Author: Jonathan L. Leger Code: QB, QBasic, PDS
' Origin: leger@earthlink.net Packet: TEXT.ABC
'===========================================================================
'========================================================================
' Simple word wrapper for text files. (Code: William Yu Date: 04-08-97)
' 100% PUBLIC DOMAIN, please use freely.
'
' Purpose: Wraps a line exceeding the specified wrap limit (WrapLimit).
' Made especially for Windows documents saved as plain text.
'========================================================================
'**************************************
'*** Modifcations by Jonathan Leger ***
'************************************************************************
'*** This is a very useful program, so I thought I would add another ***
'*** very useful feature--justification. That way the files turn out ***
'*** to be very pleasant-looking. =) So it now justifies the output ***
'*** text. I also added the wrapping of hyphens as well as spaces, ***
'*** and the ability to search for the file you want to word wrap & ***
'*** justify (thanks to Kurt Kuzba for the menu choice routine!) ***
'************************************************************************
DEFINT A-Z
TYPE ListType
F AS STRING * 14
END TYPE
DECLARE FUNCTION Justify$ (s$, wraplimit%)
DECLARE FUNCTION GetWords (s$, Words$())
DECLARE FUNCTION ChoseFile$ (dd$)
DECLARE FUNCTION MenuChoice$ (BF() AS ListType) '*** by Kurt Kuzba
DECLARE SUB BoxBorder () '*** by Kurt Kuzba
CONST False = 0
CONST True = NOT False
SCREEN 0, 0, 0
WIDTH 80, 25
VIEW PRINT 1 TO 25
COLOR 7, 0, 0
CLS
wraplimit = 78 ' Start wrapping at which column?
COLOR 14, 1
LOCATE 1, 1: PRINT "[" + STRING$(78, " ") + "]";
LOCATE 1, 30: PRINT "Text File Word Wrapper/Justifier"
LOCATE 25, 1: PRINT "[" + STRING$(78, " ") + "]";
COLOR 3, 0
FOR y = 2 TO 23 STEP 2
FOR x = 1 TO 80 STEP 5
LOCATE y, x: PRINT ".";
NEXT x
FOR x = 4 TO 80 STEP 5
LOCATE y + 1, x: PRINT ".";
NEXT x
NEXT y
FileName$ = ChoseFile$(dd$) ' Get input file.
filenum = FREEFILE
OPEN dd$ + FileName$ FOR INPUT AS filenum ' No file checking done.
OutFile$ = "NEWDOC.TXT"
OutFileNum = FREEFILE
OPEN OutFile$ FOR OUTPUT AS OutFileNum ' No file exist checking done.
DO
LINE INPUT #filenum, Text$ ' Read in text.
Text$ = Text$ + CHR$(13) ' *** End in a carriage return for
' *** justication purposes.
IF LEN(Text$) <= wraplimit THEN ' If line does not exceed wrap limit
PRINT #OutFileNum, Text$ ' then no need to parse line.
ELSE
CantWrap = False ' Used as a dummy error (ie. WrapLimit = 1..etc)
WHILE (LEN(Text$) > wraplimit) AND (CantWrap = False)
CantWrap = True
FOR I = wraplimit TO 1 STEP -1 ' Parse backwards.
IF MID$(Text$, I, 1) = " " THEN ' For first occurence of a sp.
NewText$ = LEFT$(Text$, I - 1) ' --> Get new text.
CantWrap = False ' --> Set back to false.
EXIT FOR ' --> No more parsing needed.
ELSEIF MID$(Text$, I, 1) = "-" THEN '*** Or 1st occurence of a hyphen.
NewText$ = LEFT$(Text$, I)
CantWrap = False
EXIT FOR
END IF
NEXT I
IF CantWrap = False THEN
Text$ = MID$(Text$, I + 1, LEN(Text$))
'*** Justify the output text.
NewText$ = Justify$(NewText$, wraplimit)
PRINT #OutFileNum, NewText$
END IF
WEND
PRINT #OutFileNum, Text$ ' Dump remaining text to file.
END IF
LOOP UNTIL EOF(filenum) ' parse entire file
CLOSE filenum, OutFileNum
LOCATE 25, 3: COLOR 14, 1: PRINT "File output to " + OutFile$ + ". [*PRESS A KEY*]";
WHILE INKEY$ = "": WEND
COLOR 7, 0
CLS
END
SUB BoxBorder
COLOR 15, 1
LOCATE 7, 30
PRINT " "; CHR$(218); CHR$(194); STRING$(14, 196);
PRINT CHR$(194); CHR$(191); " ";
FOR t% = 1 TO 10
LOCATE 7 + t%, 30
PRINT " "; STRING$(2, 179); SPACE$(14); STRING$(2, 179); " ";
NEXT
LOCATE 18, 30
PRINT " "; CHR$(192); CHR$(193); STRING$(14, 196);
PRINT CHR$(193); CHR$(217); " ";
END SUB
FUNCTION ChoseFile$ (dd$)
DIM FileList(0 TO 1000) AS ListType
DIM DirList(1 TO 500) AS ListType
'*** Get current directory.
SHELL "cd > #$!file.#$!"
filenum = FREEFILE
OPEN "#$!file.#$!" FOR INPUT AS filenum
LINE INPUT #filenum, dd$
CLOSE filenum
KILL "#$!file.#$!"
DO
BoxBorder
fcount = 0
dcount = 0
IF RIGHT$(dd$, 1) <> "\" THEN dd$ = dd$ + "\"
SHELL "dir " + dd$ + "*.* /o:n > #$!file.#$!" '*** An unlikely name.
filenum = FREEFILE
OPEN "#$!file.#$!" FOR INPUT AS filenum
'*** Read in the files.
DO WHILE NOT (EOF(filenum))
LINE INPUT #filenum, F$
IF INSTR(F$, "
") > 0 THEN '*** Directory?
dcount = dcount + 1
DirList(dcount).F = LEFT$(F$, 12)
ELSEIF LEFT$(F$, 1) <> " " AND F$ <> "" THEN '*** File?
IF LEFT$(F$, 12) <> "#$!FILE #$!" THEN
fcount = fcount + 1
FileList(fcount).F = LEFT$(F$, 12)
END IF
END IF
LOOP
CLOSE filenum: KILL "#$!file.#$!" '*** Kill the list file.
dc = 0
FOR nextf = fcount + 1 TO fcount + dcount + 1
dc = dc + 1
FileList(nextf).F = "[" + DirList(dc).F + "]"
NEXT nextf
FileList(0).F = LTRIM$(RTRIM$(STR$(nextf - 2)))
Fchoice$ = LTRIM$(RTRIM$(MenuChoice$(FileList())))
IF Fchoice$ = "" THEN
END
ELSEIF LEFT$(Fchoice$, 1) = "[" THEN
dd$ = dd$ + LTRIM$(RTRIM$(MID$(Fchoice$, 2, LEN(Fchoice$) - 1)))
ELSE
File$ = LEFT$(Fchoice$, INSTR(Fchoice$, " ") - 1)
File$ = File$ + "." + MID$(Fchoice$, 10, 3)
EXIT DO
END IF
LOOP
ChoseFile$ = File$
END FUNCTION
'****************************************
'*** GetWords() *** by Jonathan Leger ***
'*******************************************
'*** Extracts all "words" from a string, ***
'*** where a "word" is considered any ***
'*** set of characters the lies between ***
'*** two spaces. ***
'*******************************************
FUNCTION GetWords (s$, Words$())
wordcount = 0
spaceloc = INSTR(s$, " ") '*** First space!
IF spaceloc > 0 THEN
'*** Store first word.
wordcount = wordcount + 1
Words$(wordcount) = LEFT$(s$, spaceloc - 1)
s$ = RIGHT$(s$, LEN(s$) - spaceloc)
'*** Extract remaining words.
s$ = LTRIM$(s$) '*** Just in case there are extra spaces.
spaceloc = INSTR(s$, " ")
DO WHILE spaceloc
wordcount = wordcount + 1
Words$(wordcount) = LEFT$(s$, spaceloc - 1)
s$ = LTRIM$(RIGHT$(s$, LEN(s$) - spaceloc))
spaceloc = INSTR(s$, " ")
LOOP
'*** Get last word.
wordcount = wordcount + 1
Words$(wordcount) = LTRIM$(RTRIM$(s$)) '*** Remove extra spaces.
'*** Return number of words in string.
GetWords = wordcount
ELSE
'*** No words to extract!
GetWords = 0
EXIT FUNCTION
END IF
END FUNCTION
'****************************************
'*** Justify$() *** by Jonathan Leger ***
'****************************************
'*** Justifies a string of text to the***
'*** number of sps specified in ***
'*** . ***
'****************************************
FUNCTION Justify$ (s$, wraplimit)
DIM Words$(1 TO 50) '*** Allow for 50 words--should be plenty!
'*** First we need to determine if we _want_ to justify the line.
'*** I altered the main code of the program to append a carriage return
'*** to the end of each line. If the line we're working with ends in
'*** that carriage return (since BASIC strips the CR in its INPUT routine),
'*** then it's the end of a paragraph, so we don't justify it.
IF RIGHT$(s$, 1) = CHR$(13) THEN
'*** Ends in CR--(strip the CR)--don't justify.
Justify$ = LEFT$(s$, LEN(s$) - 1)
ELSE
'*** Put all of the words in the line into Words$()
numwords = GetWords(s$, Words$())
IF numwords > 0 THEN
'*** Figure out how long the string is presently
'*** (after adding a space to the end of each word--except the last one)
slen = 0
FOR word = 1 TO numwords - 1
Words$(word) = Words$(word) + " "
slen = slen + LEN(Words$(word))
NEXT word
slen = slen + LEN(Words$(numwords))
midword = CINT(numwords / 2) '*** Roughly the middle of the string.
prvword = midword
nxtword = midword + 1
begword = 1
lastword = numwords - 1
DO WHILE slen < wraplimit '*** Keep goin' til the right length.
'*** Add spaces in this order:
'*** after middle word
'*** after first word
'*** before last word
'*** word left of middle word <----+
'*** after second word |
'*** before second to last word |
'*** word right of middle word |
'*** after third word |
'*** before third to last word ----+
'*** Got it?
Words$(prvword) = Words$(prvword) + " "
slen = slen + 1
prvword = prvword - 1
IF prvword = begword OR prvword < 1 THEN
prvword = midword - 1
END IF
IF slen < wraplimit THEN
Words$(begword) = Words$(begword) + " "
slen = slen + 1
begword = begword + 1
IF begword = midword THEN
begword = 1
END IF
IF slen < wraplimit THEN
Words$(lastword) = Words$(lastword) + " "
slen = slen + 1
lastword = lastword - 1
IF lastword = nxtword OR lastword < 1 THEN
lastword = numwords - 1
END IF
IF slen < wraplimit THEN
Words$(nxtword) = Words$(nxtword) + " "
slen = slen + 1
nxtword = nxtword + 1
IF nxtword = lastword THEN
nxtword = midword + 1
END IF
END IF
END IF
END IF
LOOP
s$ = ""
FOR word = 1 TO numwords
s$ = s$ + Words$(word)
NEXT word
'*** Justified!
Justify$ = s$
ELSE
'*** No words, can't justify, so abort.
Justify$ = s$
END IF
END IF
END FUNCTION
FUNCTION MenuChoice$ (BF() AS ListType)
hi% = VAL(BF(0).F): choice% = 1: index% = 1
DO
FOR t% = 0 TO 9
LOCATE 8 + t%, 33, 0
COLOR 15, 1: IF choice% = (t% + index%) THEN COLOR 1, 7
s$ = SPACE$(14)
IF (t% + index%) <= hi% THEN MID$(s$, 2) = BF(t% + index%).F
IF MID$(s$, 2, 1) = "[" THEN MID$(s$, 13, 1) = "]"
PRINT s$;
NEXT
DO: k$ = UCASE$(INKEY$): LOOP WHILE k$ = ""
k% = ASC(k$): IF k% = 0 THEN k% = -ASC(MID$(k$, 2))
SELECT CASE k%
CASE 13: MenuChoice$ = BF(choice%).F: EXIT DO
CASE 27: MenuChoice$ = "": EXIT DO
CASE -71: choice% = 1: index% = 1
CASE -72: choice% = choice% + (choice% > 1)
IF choice% < index% THEN index% = choice%
CASE -73: choice% = choice% - 10: index% = index% - 10
IF choice% < 1 THEN choice% = 1
IF index% < 1 THEN index% = 1
CASE -79: choice% = hi%: index% = hi% - 9
IF index% < 1 THEN index% = 1
CASE -80: choice% = choice% - (choice% < hi%)
IF index% < (choice% - 9) THEN index% = choice% - 9
CASE -81: choice% = choice% + 10: index% = index% + 10
IF choice% > hi% THEN choice% = hi%
IF index% < (choice% - 9) THEN index% = choice% - 9
END SELECT
LOOP
END FUNCTION