; Autor : b!g b@$s

#aString = 0
#aByte = 1
#aWord = 2
#aLong = 4
#aFloat = 4


Structure Tableau
  sizeElt.b
  nbrElts.w
  adr.l
  strg.b
EndStructure


; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;- Renvoi la taille du tableau
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Procedure.w SizeOfArray(*tab.Tableau)
  ; le tableau n'a pas été initialisé
  If *tab = #Null
    ProcedureReturn(#Null)
  EndIf
  
  ProcedureReturn(*tab\nbrElts)

EndProcedure



; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;- Verifie l indice et l'adresse du tableau
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Procedure ControleIndice(*tab.Tableau, index.w)
  ; le tableau n'a pas été initialisé
  If *tab = #Null
    ProcedureReturn(- 1)
  EndIf
  
  ; indice en dehors des limites du tableau
  If index < 0 Or index >= *tab\nbrElts
    ProcedureReturn(- 2)
  EndIf
EndProcedure



; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;- Alloue la memoire au tableau
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Procedure InitTab(size.b, nbr.w)
  ; pour voir si c'est un tableau de chaine de caractère ou pas
  If size = #aString
    size = #aLong: strg.b = 1
  Else
    strg.b = 0
  EndIf
  
  *tab.Tableau = AllocateMemory(SizeOf(Tableau))
  *b = AllocateMemory(size * nbr)
  
  If *tab
    *tab\adr = *b
    *tab\sizeElt = size
    *tab\nbrElts = nbr
    *tab\strg = strg
    
    ; si c'est un tableau de string
    If strg
      For i = 0 To nbr - 1
        *a = AllocateMemory(1)
        If *a
          PokeL(*tab\adr +(i * #aLong), *a)
          PokeS(*a, "")
        EndIf
      Next i
    EndIf
    
    ProcedureReturn(*tab)
  Else
    ProcedureReturn(#Null)
  EndIf
EndProcedure



; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;- Redimension du tableau
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Procedure Redim(*tab.Tableau, nbr.w)
  If *tab = #Null
    ProcedureReturn(- 1)
  EndIf
  
  ; si c'est un tableau de string, on efface l'espace mémoire réservé aux strings
  If *tab\strg
    ; on enleve les cases en trop
    For i = nbr To *tab\nbrElts - 1
      ad.l = PeekL(*tab\adr +(i * #aLong))
      If ad
        FreeMemory(ad)
      EndIf
    Next i
    
    ; on rajoute les cases en moins
    For i = *tab\nbrElts To nbr - 1
      *a = AllocateMemory(1)
      If *a
        PokeL(*tab\adr +(i * #aLong), *a)
        PokeS(*a, "")
      EndIf
    Next i
  EndIf
    
  *tab\adr = ReAllocateMemory(*tab\adr, *tab\sizeElt * nbr)
  *tab\nbrElts = nbr
EndProcedure




; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;- Suppression du tableau
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Procedure UnDim(*tab.Tableau)
  If *tab = #Null
    ProcedureReturn
  EndIf
  
    ; si c'est un tableau de string, on efface l'espace mémoire réservé aux strings
  If *tab\strg
    For i = 0 To *tab\nbrElts
      ad.l = PeekL(*tab\adr +(i * #aLong))
      If ad
        FreeMemory(ad)
      EndIf
    Next i
  EndIf
  
  FreeMemory(*tab\adr)
  *tab\adr = #Null
  *tab\nbrElts = 0
EndProcedure



; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;- On Ajoute un Object au tableau
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Procedure SetObject(*tab.Tableau, index.w, *obj)
  If ControleIndice(*tab.Tableau, index.w) < 0
    ProcedureReturn(- 1)
  EndIf
  
  ; obj ne pointe sur rien
  If @*obj = #Null
    ProcedureReturn(- 3)
  EndIf
  
  CopyMemory(@*obj, *tab\adr +(*tab\sizeElt * index), *tab\sizeElt)
EndProcedure

Procedure SetByte(*tab.Tableau, index.w, b.b)
  If ControleIndice(*tab.Tableau, index.w) < 0
    ProcedureReturn(- 1)
  ElseIf *tab\sizeElt <> #aByte
    ProcedureReturn(- 1)
  Else
    PokeB(*tab\adr +(#aByte * index), b)
  EndIf
EndProcedure

Procedure SetWord(*tab.Tableau, index.w, w.w)
  If ControleIndice(*tab.Tableau, index.w) < 0
    ProcedureReturn(- 1)
  ElseIf *tab\sizeElt <> #aWord
    ProcedureReturn(- 1)
  Else
    PokeW(*tab\adr +(#aWord * index), w)
  EndIf
EndProcedure

Procedure SetFloat(*tab.Tableau, index.w, f.f)
  If ControleIndice(*tab.Tableau, index.w) < 0
    ProcedureReturn(- 1)
  ElseIf *tab\sizeElt <> #aFloat Or *tab\strg
    ProcedureReturn(- 1)
  Else
    PokeF(*tab\adr +(#aFloat * index), f)
  EndIf
EndProcedure

Procedure SetLong(*tab.Tableau, index.w, l.l)
  If ControleIndice(*tab.Tableau, index.w) < 0
    ProcedureReturn(- 1)
  ElseIf *tab\sizeElt <> #aLong Or *tab\strg
    ProcedureReturn(- 1)
  Else
    PokeL(*tab\adr +(#aLong * index), l)
  EndIf
EndProcedure

Procedure SetString(*tab.Tableau, index.w, s.s)
  If ControleIndice(*tab.Tableau, index.w) < 0
    ProcedureReturn(- 1)
  ElseIf *tab\sizeElt <> #aLong
    ProcedureReturn(- 1)
  Else
    If PeekL(*tab\adr +(#aLong * index))
      ; si le block existe déja, on le redmensionne
      *a = ReAllocateMemory(PeekL(*tab\adr +(#aLong * index)), Len(s))
    Else
      ; sinon on le crée
      *a = AllocateMemory(Len(s))
    EndIf

    If *a = #Null
      ProcedureReturn(- 1)
    Else
      PokeS(*a, s)
      PokeL(*tab\adr +(#aLong * index), *a)
    EndIf
  EndIf
EndProcedure





; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;- On recupere l adresse de la case memoire du tableau
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Procedure GetObject(*tab.Tableau, index.w)
  If ControleIndice(*tab.Tableau, index.w) < 0
    ProcedureReturn(#Null)
  EndIf
  
  If index < 0 Or index >= *tab\nbrElts
    ProcedureReturn(#Null)
  EndIf
  
  ProcedureReturn( *tab\adr +(*tab\sizeElt * index) )
EndProcedure

Procedure GetNewObject(*tab.Tableau, index.w)
  *a = GetObject(*tab.Tableau, index)
  *b = AllocateMemory(*tab\sizeElt)
  If *b
    CopyMemory(*a, *b, *tab\sizeElt)
    ProcedureReturn( *b )
  EndIf
EndProcedure

Procedure GetByte(*tab.Tableau, index.w)
  *a = GetObject(*tab.Tableau, index)
  If *tab\sizeElt <> #aByte
    ProcedureReturn(#Null)
  ElseIf *a = #Null
    ProcedureReturn(#Null)
  Else
    ProcedureReturn(PeekB(*a))
  EndIf
EndProcedure

Procedure GetWord(*tab.Tableau, index.w)
  *a = GetObject(*tab.Tableau, index)
  If *tab\sizeElt <> #aWord
    ProcedureReturn(#Null)
  ElseIf *a = #Null
    ProcedureReturn(#Null)
  Else
    ProcedureReturn(PeekW(*a))
  EndIf
EndProcedure

Procedure GetFloat(*tab.Tableau, index.w)
  *a = GetObject(*tab.Tableau, index)
  If *tab\sizeElt <> #aFloat Or *tab\strg
    ProcedureReturn(#Null)
  ElseIf *a = #Null
    ProcedureReturn(#Null)
  Else
    ProcedureReturn(PeekF(*a))
  EndIf
EndProcedure

Procedure GetLong(*tab.Tableau, index.w)
  *a = GetObject(*tab.Tableau, index)
  If *tab\sizeElt <> #aLong Or *tab\strg
    ProcedureReturn(#Null)
  ElseIf *a = #Null
    ProcedureReturn(#Null)
  Else
    ProcedureReturn(PeekL(*a))
  EndIf
EndProcedure

Procedure.s GetString(*tab.Tableau, index.w)
  *a = GetObject(*tab.Tableau, index)
  If *tab\sizeElt <> #aLong Or *tab\strg = 0
    ProcedureReturn("")
  ElseIf *a = #Null
    ProcedureReturn("")
  Else
    ProcedureReturn(PeekS(PeekL(*a)))
  EndIf
EndProcedure

;-                       MAIN
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; - - - - - - - - -  JEUX D'ESSAI - - - - - - - - -
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -



tailleB.b = #aByte  ; taille en octets de la structure contenue dans le tableau
elts.w = 100        ; nombrede cases du tableau

; déclaration des deux tableaux dynamiques
*tabByte.Tableau = InitTab(tailleB, elts)
*tabString.Tableau = InitTab(#aString, 10)



; /\/\/\/\/\/\/\/\ Avec des nombres /\/\/\/\/\/\/\/\/\/\
; \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/

Debug " - - - - TabByte - - - - "
Debug "Taille initiale : " + Str(SizeOfArray(*tabByte))

; on entre les valeurs
For i.w = 0 To 5
  SetByte(*tabByte, i, i + 5)
  SetWord(*tabByte, i, 3)
Next i

; on affiche le tableau (ses 6 1ers elts)
For i = 0 To 5
  Debug "Elts(" + Str(i) + ") : " + Str(GetByte(*tabByte, i))
Next i

Debug "Redimension du tableau"
Redim(*tabByte, 6)

Debug "La nouvelle taille est de : " + Str(SizeOfArray(*tabByte))
For i = 0 To SizeOfArray(*tabByte)- 1
  Debug "Elts(" + Str(i) + ") : " + Str(GetByte(*tabByte, i))
Next i

Debug "Libération de la mémoire"
UnDim(*tabByte)
Debug "Taille : " + Str(SizeOfArray(*tabByte))



; /\/\/\/\/\/\/\/\ Avec des strings /\/\/\/\/\/\/\/\/\/\
; \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/

Debug " "
Debug " - - - - TabString - - - - "


SetString(*tabString, 0, "Ca")
SetString(*tabString, 1, "va")
SetString(*tabString, 2, "tout")
SetString(*tabString, 3, "le")
SetString(*tabString, 4, "monde")
SetString(*tabString, 5, "???")

a$ = ""
For i = 0 To SizeOfArray(*tabString)- 1
  a$ + GetString(*tabString, i) + " "
Next i
Debug a$

Debug "Redimension du tableau"
Redim(*tabString, 5)

a$ = ""
For i = 0 To 10
  a$ + GetString(*tabString, i) + " "
Next i
Debug a$

Debug "Redimension du tableau"
Redim(*tabString, 6)
SetString(*tabString, 5, "!!!")

a$ = ""
For i = 0 To SizeOfArray(*tabString)- 1
  a$ + GetString(*tabString, i) + " "
Next i
Debug a$

Debug "Libération de la mémoire"
UnDim(*tabString)