fqvarfort fqvarfort Mar 30, 2006 - "New faster version of previous code"

Author's notes: Ever since Brad Moore publishedHere's an updated version of the great article "Working With Strings - Part 3" in LB Newsletter #141 I had been looking forcode. Uses a suitable project to test it on. When Carl suggested a Lesson Formatter I went right to work. I'm only a yearling but I did what I could with it. It's plain and it doesportion of the job--but it's V E R Y S L O W. I'm surecode from the experts can fix that. In the spiritprevious version but much of "community" I'm not putting my name on it and expect anyoneis replaced with a better idea to just go infaster and edit it. If a better oneeasier-to-follow solutions. This version is created just remove it. Because it takes several seconds to parseapprox 800% faster than the entire lesson file Iprevious version. No new features has been added the ability to save and reopen the results as a text file. I did give it a Print utility but I removed it. The font had to be reduced to a tiny point 9 and with "!lines countVar" reporting almost 5,000 lines it would take 70+ pages to print it out. Someone must know a better way. Hopefully it will at least spark an interest in XML parsing. I'll probably remove these notes after a few days. (The dangling semi-colons are actually displayed in the lessons--they had me going for a while until I realized that.)though. [[code]] 'Replace Strings function was posted by Brad Moore on conforums 11-27-05 leng=90 'length of texteditor line Global leng,leng ', tag$, comment$ WindowWidth=760 WindowHeight=590 UpperLeftX = Int((DisplayWidth - WindowWidth)/2) UpperLeftY = Int((DisplayHeight - WindowHeight)/2) Nomainwin Menu #main, "&File", "&Open", getTutorial, "&Save", saveText, "&Quit", quitMenu Texteditor #main.tb1, 5, 5, 740, 500 Statictext #main.status, "", 680, 510, 60, 25 Open "Parse Liberty Basic 4 Tutorial" for Window as #main Print #main, "Trapclose quit" Print #main.tb1, "!autoresize"; Print #main, "Font Courier_New 10" Print #main.status, "!Font Courier_New 11 Bold" Print #main.status, "!Hide" 'otherwise will be visible if texteditor is maximized Call getTutorial Wait '********************** SUBS AND FUNCTIONS ************************* Sub quitMenu Call quit handle$ End Sub Sub quit handle$ Close #main End Sub Sub getTutorial oldtimer = time$("ms") Filedialog "Open Liberty Basic lesson file", "*.lsn;*.txt", fileName$ If Right$(fileName$,3) = "txt" Then Call getText fileName$ If fileName$<>"" Then Print #main.status, "!Show" OpenOpen fileName$ For Input As #1 Open fileName$; ".txt" For Output As #2 ProgressLOF = LOF(#1) Do 'Read next line Line Input #1, comment$ 'Get the tag of current line "<TAG>" startPos=Instr(comment$,"<",marker) endPos=Instr(comment$,">",marker) tag$ = Left$(comment$,endPos-startPos+1) progress=progress+1 Print #main.status, Int(progress*.051); " %" 'calculated by 100/1958 lines 'Update progressbar Gosub [ProgressUpdate] 'Print 2 blank lines in 'front of lesson titles Select Case tag$ CaseCase "<lesson-title>" Call blankLines 2 Call lessonTitle comment$ Call blankLines 2 Case "<lesson-comment>" Line Input #1, comment$ progress=progress+1 Print #main.status, Int(progress*.051); " %" Call printComments comment$ Call blankLines 2 Case "<lesson-code>" Line Input #1, comment$ progress=progress+1 Print #main.status, Int(progress*.051); " %" Call printCode comment$ Call blankLines 2 Case "<chapter-title>" Call chapterTitle comment$ Call blankLines 2 Case "<chapter-comment>" Line Input #1, comment$ progress=progress+1 Print #main.status, Int(progress*.051); " %" Call printComments comment$ Call blankLines 2 Case "<section-title>" Call sectionTitle comment$ Call blankLines 2 Case "<section-comment>" Line Input #1, comment$ progress=progress+1 Print #main.status, Int(progress*.051); " %" Call printComments comment$ Call blankLines 2 Case "<section-code>" Line Input #1, comment$ progress=progress+1 Print #main.status, Int(progress*.051); " %" Call printCode comment$ Call blankLines 2 Case "<example-title>" Call exampleTitle comment$ Call blankLines 2 Case "<example-comment>" Line Input #1, comment$ progress=progress+1 Print #main.status, Int(progress*.051); " %" Call printComments comment$ Call blankLines 2 Case "<example-code>" Line Input #1, comment$ progress=progress+1 Print #main.status, Int(progress*.051); " %" Call printCode comment$ Call blankLines Call printBlankLines 2 End Select 'Print value (code, comments or title) Select Case tag$ case "<lesson-code>", "<section-code>", "<example-code>" Line Input #1, comment$ Gosub [ProgressUpdate] Call printCode comment$ Case "<lesson-comment>", "<chapter-comment>", "<section-comment>", "<example-comment>" Line Input #1, comment$ Gosub [ProgressUpdate] Call printComments comment$ Case "<lesson-title>", "<section-title>", "<chapter-title>", "<example-title>" startPos=Instr(comment$,">",1)+1 endPos=Instr(comment$,"</",1)-1 comment$=Mid$(comment$,startPos,endPos-(startPos-1)) call printTitle comment$ Case Else comment$ = "" End Select 'Print 2 blank lines 'below the value if (comment$ <> "") then call printBlankLines 2 End if Loop While eof(#1) = 0 Print #main.status, "" Close #1 Close #2 text$ = GetFileContents$(fileName$; ".txt") Print #main.tb1, "!contents text$" Print #main.status, "!Hide" Print #main.tb1, "!origin 1 1" ; EndEnd if End Print "Time: "; time$("ms") - oldtimer Exit Sub [ProgressUpdate] 'See how far we have read in the 'lsn file and calculate the new 'progress %, only update the 'status when the progress % 'has actually changed ProgressLOC = LOC(#1) ProgressNew = Int((ProgressLOC / ProgressLOF) * 100) If (ProgressNew <> ProgressOld) Then ProgressOld = ProgressNew Print #main.status, ProgressNew; " %" End If Return End Sub Sub getText fileName$ Open fileName$ For Input As #1 Print #main.tb1, "!contents #1"; Close #1 EndEnd Sub Sub saveText Filedialog "Save As... (TEXT ONLY)", "*.txt", fileName2$ If fileName2$<> "" Then Open fileName2$ For Output As #1 Print #main.tb1, "!contents? textTutorial$"; Print #1, textTutorial$ Close #1 End If EndEnd Sub Sub lessonTitle comment$ startPos=Instr(comment$,"<lesson-title>",1)+14 endPos=Instr(comment$,"</lesson-title>",1)-1 title$=Mid$(comment$,startPos,endPos-(startPos-1)) Print #main.tb1, Space$(int(leng/2)-(int(len(title$)/2)));printTitle title$ End Sub Sub chapterTitle comment$ startPos=Instr(comment$,"<chapter-title>",1)+15 endPos=Instr(comment$,"</chapter-title>",1)-1 title$=Mid$(comment$,startPos,endPos-(startPos-1)) Print #main.tb1, Print #2, Space$(int(leng/2)-(int(len(title$)/2))); Print #2, title$ End Sub Sub sectionTitle comment$ startPos=Instr(comment$,"<section-title>",1)+15 endPos=Instr(comment$,"</section-title>",1)-1 title$=Mid$(comment$,startPos,endPos-(startPos-1)) Print #main.tb1, Space$(int(leng/2)-(int(len(title$)/2))); title$ EndEnd Sub Sub exampleTitle comment$ startPos=Instr(comment$,"<example-title>",1)+15 endPos=Instr(comment$,"</example-title>",1)-1 title$=Mid$(comment$,startPos,endPos-(startPos-1)) Print #main.tb1, Space$(int(leng/2)-(int(len(title$)/2))); title$ End SubprintCode code$ Sub printCode comment$ If Right$(comment$, If Right$(code$, 32) = "no code example for this section" Then Exit Sub If Right$(comment$, If Right$(code$, 28) = "place your example code here" Then Exit Sub line3$=replaceStr$(comment$, "&#9;", " ") 'convert tab comment$ = line3$ line3$=replaceStr$(comment$, "&quot;", chr$(34)) 'quotation mark comment$ = line3$ line3$=replaceStr$(comment$, "&lt;", "<") 'lesser than comment$ = line3$ line3$=replaceStr$(comment$, "&gt;", ">") 'greater than comment$ = line3$ line3$=replaceStr$(comment$, "&amp;", "&") 'ampersand comment$ = line3$ newCode$=replaceStr$(comment$,"&#13;&#10;",chr$(13)+chr$(10)) 'line break Print #main.tb1, newCode$ End Call ConvHTML2Text code$ Call WordWrapCode code$, leng Print #2, code$ End Sub Sub printComments comment$ x=1 longLine$=Word$(comment$,x,"&#13;&#10;") While longLine$ <> "" If longLine$ <> "&#13;&#10;" Then y=1 Do Do Until Len(line2$) > leng line1$=Word$(longLine$,y) line3$=replaceStr$(line1$, "&#9;", " ") 'convert tab line1$ = line3$ line3$=replaceStr$(line1$, "&quot;", chr$(34)) 'quotation mark line1$ = line3$ line3$=replaceStr$(line1$, "&lt;", "<") 'lesser than line1$ = line3$ line3$=replaceStr$(line1$, "&gt;", ">") 'greater than line1$ = line3$ line3$=replaceStr$(comment$, "&amp;", "&") 'ampersand comment$ = line3$ temp$ = line2$ + line1$ + " " If len(temp$) > leng Then Exit Do y=y+1 line2$=temp$ Loop line3$=Trim$(line2$) Print #main.tb1, line2$ line2$="" Loop While line1$ <> "" Else Print #main.tb1, "" End If x=x+1 longLine$=Word$(comment$,x,"&#13;&#10;") Wend End Sub Sub blankLines num For x=1 To num Print #main.tb1, "" Next x End Sub Call ConvHTML2Text comment$ Call WordWrapCode comment$, leng Print #2, comment$ Function replaceStr$(original$, toReplace$, replacement$) final$End Sub Sub printBlankLines num For x=1 To num Print #2, "" Next x End Sub Sub ConvHTML2Text ByRef Text$ Call ReplaceText Text$, "&#9;", " " Call ReplaceText Text$, "&quot;", Chr$(34) Call ReplaceText Text$, "&lt;", "<" Call ReplaceText Text$, "&gt;", ">" Call ReplaceText Text$, "&amp;", "&" Call ReplaceText Text$, "&#13;&#10;", Chr$(13) + Chr$(10) End Sub Sub ReplaceText ByRef Text$, ReplaceFrom$, ReplaceTo$ Pos = original$ If len(original$)InStr(Text$, ReplaceFrom$) Do While (Pos > 0 And len(toReplace$) > 00) Text$ = Left$(Text$, Pos - 1) + ReplaceTo$ + Mid$(Text$, Pos + Len(ReplaceFrom$)) Pos = InStr(Text$, ReplaceFrom$) Loop End Sub Sub WordWrapCode ByRef Text$, length CurrStart = 1 Do CurrEnd = InStr(Text$, Chr$(13) + Chr$(10), CurrStart) If (CurrEnd = 0) Then pos CurrEnd = instr(original$, toReplace$) If pos > 0(Len(Text$) + 1) CurrLength = (CurrEnd - CurrStart - 1) If (CurrLength < length) Then l$ CurrStart = left$(original$, pos-1) r$(CurrEnd + 2) Else CurrEnd = mid$(original$, pos+len(toReplace$)) final$CurrStart Do LastEnd = l$CurrEnd CurrEnd = InStr(Text$, " ", CurrEnd + replacement$1) If (CurrEnd = 0) Then CurrEnd = (Len(Text$) + r$1) Exit Do End If CurrLength = (CurrEnd - CurrStart - 1) Loop While (CurrLength < length) Text$ = Left$(Text$, LastEnd) + Chr$(13) + Chr$(10) + Mid$(Text$, LastEnd + 1) CurrStart = (LastEnd + 3) End If If instr(original$, toReplace$, 1) > 0 Then final$ = replaceStr$(final$, toReplace$, replacement$) End If replaceStr$ = final$ End Function [[code]]Loop While (CurrStart < Len(Text$)) And for anyone interested here's the file structure:End Sub [[code]] ____________<lesson> | | <lesson-title></lesson-title> | <author></author> | <lesson-comment></lesson-comment> | <lesson-code></lesson-code> | | ____________<chapters> | | | | _______<chapter> | | | | | | <chapter-title></chapter-title> | | | <chapter-comment></chapter-comment> | | | <chapter-code></chapter-code> | | | | | | ____________<sections> | | | | | | | | _______<section> | | | | | | | | | | <section-title></section-title> | | | | | <section-comment></section-comment> | | | | | <section-code></section-code> | | | | | | | | | | ____________<examples> | | | | | | | | | | | | _______<example> | | | | | | | | | | | | | | <example-title></example-title> | | | | | | | <example-comment></example-comment> | | | | | | | <example-code></example-code> | | | | | | | | | | | | | |_______</example> | | | | | | | | | | | |____________</examples> | | | | | | | | | |_________________</section> | | | | | | | |______________________</sections> | | | | | |___________________________</chapter> | | | |________________________________</chapters> | |_____________________________________</lesson>Function GetFileContents$(Filename$) Open Filename$ For Input As #2 GetFileContents$ = Input$(#2, LOF(#2)) Close #2 End Function [[code]]