'=========================================================================== ' 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