PureBasic

Code : Tout sélectionner

Structure subString
  ;if *sa = #Null then s.s contains the element, otherwise s.s is ignored and *sa points to another arraySubString as the element.
  ;si *sa = #Null alors s.s contient l'élément, sinon s.s est ignoré et *sa pointe vers un autre arraySubString comme élément.
  s.s
  *sa.arraySubString
EndStructure

Structure arraySubString
  Array e.subString(0)
EndStructure

Structure charArrayPtr
  c.c[0]
EndStructure

;Creates a SubString Array representation from a formatted string and returns the address of the new structure that was created.
;If formatted string is empty it returns zero, if there is not an equal number of left and right brackets it returns -1.
;If the address of a initial structure was passed in then that same address will be returned if the formatted string is not in error.
;Crée une représentation de type SubString Array à partir d'une chaîne formatée et renvoie l'adresse de la nouvelle structure qui a été créée.
;Si la chaîne formatée est vide, il renvoie zéro, s'il n'y a pas un nombre égal de crochets à gauche et à droite, il renvoie -1.
;Si l'adresse d'une structure initiale a été transmise, cette même adresse sera renvoyée si la chaîne formatée n'est pas erronée.
Procedure.i createSubStringArray(*t.arraySubString, i$)
  Protected ic, ic_end, x = Len(i$), *charPtr.charArrayPtr, index_el, max_el, depth
  
  ;Debug i$
  If *t = 0
    *t = AllocateStructure(arraySubString)
  EndIf
    
  If CountString(i$, "[") <> CountString(i$, "]")
    ;badly formed string, does not have same number of matching brackets ;chaîne mal formée, n'a pas le même nombre de parenthèses correspondantes
    ProcedureReturn -1 
  ElseIf x = 0 
    
    ProcedureReturn 0 ;empty string ;chaîne vide
  Else
    *charPtr = @i$
    If *charPtr\c[ic] <> '[' Or *charPtr\c[x - 1] <> ']'
      ProcedureReturn -1 ;badly formed string, needs left and right brackets ;chaîne mal formée, nécessite des crochets gauche et droit
    EndIf
    ic + 1
  EndIf
  
  ;count total elements ;compter les éléments totaux
  ic_end = ic
  While ic_end <> x
    Select *charPtr\c[ic_end]
      Case '['
        depth + 1
      Case ']'
        depth - 1
        If depth < 0
          ;malformed string, more closing brackets occur before opening brackets ;chaîne malformée, plus de crochets de fermeture se produisent avant les crochets d'ouverture
          x = ic_end ;reduce length of string ;réduire la longueur de la chaîne
          Break 
        EndIf
      Case ','
        If depth = 0
          max_el + 1
        EndIf
    EndSelect
    ic_end + 1
  Wend

  Dim *t\e(max_el)
  ;Debug max_el
  While ic <= x
    If *charPtr\c[ic] <> '[' ;simple string ;chaîne simple
      ic_end = ic + 1
      While *charPtr\c[ic_end] <> ',' And *charPtr\c[ic_end] <> ']' And ic_end < x
        ic_end + 1
      Wend
      ;Debug Str(index_el) + "'" + PeekS(*charPtr + ic * SizeOf(character), ic_end - ic) + "'"
      *t\e(index_el)\s = PeekS(*charPtr + ic * SizeOf(character), ic_end - ic)
      
    Else ;sub-array string ;chaîne de sous-Tableau
      ;count total elements ;compter les éléments totaux
      ic_end = ic + 1
      depth = 0
      While ic_end <> x
        Select *charPtr\c[ic_end]
          Case '['
            depth + 1
          Case ']'
            depth - 1
            If depth < 0 ;end of string ;fin de la chaîne
              Break 
            EndIf
          Case ','
            If depth = 0
            EndIf
        EndSelect
        ic_end + 1
      Wend
      ic_end + 1
      ;Debug Str(index_el) + " array "
      *t\e(index_el)\sa = createSubStringArray(0, PeekS(*charPtr + ic * SizeOf(character), ic_end - ic))
    EndIf
    
    If *charPtr\c[ic_end] = ','
      ic_end + 1
      While ic_end < x And *charPtr\c[ic_end] = ' '
        ic_end + 1
      Wend
      ic = ic_end
    ElseIf *charPtr\c[ic_end] = ']'
      Break ;exit the loop and return results ;sortir la boucle et renvoyer les résultats
    EndIf
      
    index_el + 1
  Wend
  
  ProcedureReturn *t
EndProcedure

;display formatted contents of SubStringArray ;afficher le contenu formaté de SubStringArray
Procedure.s outputSubStringArray(*t.arraySubString)
  Protected i, o$, x = ArraySize(*t\e())
  
  If x <> -1
    o$ = "["
    i = 0
    While i <= x
      If *t\e(i)\sa = 0
        o$ + *t\e(i)\s
      Else
        o$ + outputSubStringArray(*t\e(i)\sa)
      EndIf
      o$ + ", "
      i + 1
    Wend
    
    ProcedureReturn ReplaceString(o$, ", ", "]", #PB_String_NoCase, Len(o$) - 2)
  Else
    ProcedureReturn "[]" ;empty ;vide
  EndIf
EndProcedure

;Free contents of SubStringArray structure and sub-structures previous created with createSubStringArray()
;Set is_ByValue = False if freeing a variable (i.e. Tableau.arraySubString) instead of a pointer.
;Returns contents of SubStringArray.
;Contenu libre de la structure SubStringArray et des sous-structures précédemment créées avec createSubStringArray()
;Set is_ByValue = False si l'on libère une variable (par exemple Tableau.arraySubString) au lieu d'un pointeur.
;Renvoie le contenu du tableau SubStringArray.
Procedure.s freeSubStringArray(*t.arraySubString, is_ByValue = #True)
  Protected i, o$, x = ArraySize(*t\e())
  
  o$ = outputSubStringArray(*t)
  
  i = 0
  While i <= x
    If *t\e(i)\sa <> 0
      freeSubStringArray(*t\e(i)\sa)
      *t\e(i)\sa = 0
    EndIf
    i + 1
  Wend
  
  If is_ByValue
    FreeStructure(*t)
  Else
    ClearStructure(*t, arraySubString)
  EndIf
  
  ProcedureReturn o$
EndProcedure


CompilerIf #PB_Compiler_IsMainFile
  
  Define Tableau.arraySubString, Tableu2.arraySubString, result
  
  Define x$ = "[123, [234, Def], Abc, [345, [456, Mno, 567], Jkl], Ghi]"
  
  result = createSubStringArray(@Tableau, x$)
  Select result
    Case -1
      Debug "Formatted string contains unmatching brackets."
    Case 0
      Debug "Formatted string is empty."
    Default
      Debug "arraySubString structure created at address " + result + "."
  EndSelect
  
  
  Debug outputSubStringArray(@Tableau)
  
  freeSubStringArray(@Tableau, #False)
CompilerEndIf