Find matching brackets (or other nested tag pairs)
Posted: Sun Oct 09, 2016 6:32 am
Hi once more. Here is some stuff which can parse nested brackets or other tags.
Tag len currently is limited to 1 char, but can be easily modified to fit any len.
Also it's not too optimized, I've just made it 30 min ago for "let it do what needed" ^^
But should be fine enough anyway. Additionaly, some error-correction added for cases when opening or closing tag is missing.
Tag len currently is limited to 1 char, but can be easily modified to fit any len.
Also it's not too optimized, I've just made it 30 min ago for "let it do what needed" ^^
But should be fine enough anyway. Additionaly, some error-correction added for cases when opening or closing tag is missing.
Code: Select all
EnableExplicit
; v 1.0.0.1
; 2016 (c) Luna Sole
; returns array with string data between matching pair of 2 specified chars
; StrIn$ a string to parse
; Char1$ character which opens pair
; Char2$ closing character
; UseWildcards if true, then wildcards like "Char1$ + % + INDEX + % + Char2$" are used instead of nested pairs
; RETURN: number of pairs found and data placed to Out$() array starting from index 1
Procedure GetPairs (Array Out$(1), StrIn$, Char1$ = "[", Char2$ = "]", UseWildcards = #False)
Protected CntMin, LenMax = Len(StrIn$)
Protected Dim Chars1.POINT(LenMax), Cnt1, Tmp1 ; the X field used to mark Char1 positions
Protected Dim Chars2.POINT(LenMax), Cnt2, Tmp2 ; Y - to mark Char2
Protected Tmp, tChr$ = " "
Protected OutCount
; step 1, mark all matches
For Tmp = 1 To LenMax
PokeC(@tChr$, PeekC(@StrIn$ + (Tmp - 1) * SizeOf(Character))) ; tChr$ = Mid(StrIn$, Tmp, 1)
If tChr$ = Char1$
Cnt1 + 1 ; opening char found
Chars1(Cnt1)\x = Tmp
ElseIf tChr$ = Char2$
Cnt2 + 1 ; closing char
Chars2(Cnt2)\y = Tmp
EndIf
Next Tmp
; step 2, fix mismatches + prepare output buffer
If Cnt1 > Cnt2
Cnt2 + 1
CntMin = 1
Chars2(Cnt2)\y = LenMax
Dim Out$(Cnt1)
ElseIf Cnt2 > Cnt1
Chars1(0)\x = 1
CntMin = 0
Dim Out$(Cnt2)
Else
CntMin = 1
Dim Out$(Cnt1)
EndIf
; step 3, collect results
For Tmp1 = Cnt1 To CntMin Step -1
For Tmp2 = 1 To Cnt2
If Chars2(Tmp2)\y > Chars1(Tmp1)\x
Chars1(Tmp1)\y = Chars2(Tmp2)\y
OutCount + 1
If UseWildcards And OutCount > 1
If Chars1(Tmp1 + 1)\x >= Chars1(Tmp1)\x And Chars1(Tmp1 + 1)\y <= Chars1(Tmp1)\y
; add result with wildcard
Out$(OutCount) = Mid(StrIn$, Chars1(Tmp1)\x, Chars1(Tmp1 + 1)\x - Chars1(Tmp1)\x) +
Char1$ + "%" + Str(OutCount - 1) + "%" + Char2$ +
Mid(StrIn$, Chars1(Tmp1 + 1)\y + 1, Chars1(Tmp1)\y - Chars1(Tmp1 + 1)\y)
Else
Out$(OutCount) = Mid(StrIn$, Chars1(Tmp1)\x, 1 + Chars1(Tmp1)\y - Chars1(Tmp1)\x)
EndIf
Else
; add raw result
Out$(OutCount) = Mid(StrIn$, Chars1(Tmp1)\x, 1 + Chars1(Tmp1)\y - Chars1(Tmp1)\x)
EndIf
Chars2(Tmp2)\y = -1
Break
EndIf
Next Tmp2
Next Tmp1
; fin
ProcedureReturn OutCount
EndProcedure
;;;;;;;;;
; usage ;
Global Dim T$(0)
Global Tmp
Debug Str(GetPairs(T$(), "[0][1][2][5[6]]", "[", "]", 1)) + " found:" ; that doesn't work OK in previous version
For Tmp = 1 To ArraySize(T$())
Debug T$(Tmp)
Next Tmp
Debug ""
Debug Str(GetPairs(T$(), "[000[11[2[33]2]11]000]", "[", "]", 1)) + " found:"
For Tmp = 1 To ArraySize(T$())
Debug T$(Tmp)
Next Tmp
Debug ""
; here should be example using recursive wildcards expanding, but looks like I'm too lazy to finish it today ^^
; Out$(Count) = ReplaceString(Out$(Count), Char1$ + "%" + Str(Count - 1) + "%" + Char2$, Out$(Count-1))
