Basic Univers
; Auteur : Dr Dri

;-Procedures memoire

Procedure ZeroMemory(*adresse.Byte, taille.l)
  If *adresse <> #NULL
 
    While taille > 0
      *adresse\b = #NULL
      *adresse + 1
      taille - 1
    Wend
   
  EndIf
EndProcedure

Procedure Swap(*a.l, *b.l, taille.l)
  Protected *c.l
  If *a <> #NULL And *b <> #NULL
    *c = AllocateMemory(taille)
    If *c <> #NULL
      CopyMemory(*a, *c, taille)
      CopyMemory(*b, *a, taille)
      CopyMemory(*c, *b, taille)
      FreeMemory(*c)
    EndIf
  EndIf
EndProcedure

;-Procedures listes chaînees

Structure Element
  *precedent.Element
  *suivant.Element
  *element.l
EndStructure

Structure Liste
  taille.l
  *courant.Element
EndStructure

Declare CreerListe(tailleElement.l)
Declare LibererListe(*liste.Liste)
Declare ViderListe(*liste.Liste)
Declare CardinalListe(*liste.Liste)
Declare IndexListe(*liste.Liste)
Declare SelectionnerElement(*liste.Liste, index)
Declare AjouterElement(*liste.Liste, *pointeurElement.l)
Declare SupprimerElement(*liste.Liste)
Declare ModifierElement(*liste.Liste, *pointeurElement.l)
Declare RecupererElement(*liste.Liste)
Declare PremierElement(*liste.Liste)
Declare ElementPrecedent(*liste.Liste)
Declare ElementSuivant(*liste.Liste)
Declare DernierElement(*liste.Liste)
Declare PourChaqueElement(*liste.Liste, *fonction.l)
Declare EchangerElements(*liste.Liste, index1.l, index2.l)

Procedure CreerListe(taille)
  Protected *lst.liste
 
  *lst = AllocateMemory( SizeOf(Liste) )
 
  If *lst <> #NULL
 
    *lst\taille = taille
    *lst\courant = #NULL
   
  EndIf
 
  ProcedureReturn *lst
EndProcedure

Procedure LibererListe(*lst.Liste)
 
  ViderListe(*lst)
  FreeMemory(*lst)
 
EndProcedure

Procedure ViderListe(*lst.Liste)
  Protected cardinal.l
 
  If *lst <> #NULL And *lst\courant <> #NULL
   
    cardinal = CardinalListe(*lst)
   
    While cardinal > 0
      SupprimerElement(*lst)
      cardinal - 1
    Wend
   
  EndIf
 
EndProcedure

Procedure CardinalListe(*lst.liste)
  Protected nb.l, *elm.Element
 
  nb = - 1
 
  If *lst <> #NULL
   
    nb + 1
   
    If *lst\courant <> #NULL
     
      nb + 1
     
      *elm = *lst\courant
      While *elm\precedent <> #NULL
        nb + 1
        *elm = *elm\precedent
      Wend
     
      *elm = *lst\courant
      While *elm\suivant <> #NULL
        nb + 1
        *elm = *elm\suivant
      Wend
     
    EndIf
   
  EndIf
 
  ProcedureReturn nb
EndProcedure

Procedure IndexListe(*lst.Liste)
  Protected *elm.Element, index.l
 
  index = - 1
 
  If *lst <> #NULL
   
    If *lst\courant <> #NULL
     
      index = 0
      *elm = *lst\courant
     
      While *elm\precedent <> #NULL
        *elm = *elm\precedent
        index + 1
      Wend
     
    EndIf
   
  EndIf
 
  ProcedureReturn index
EndProcedure

Procedure SelectionnerElement(*lst.Liste, index.l)
  Protected *elm.Element
 
  *elm = #NULL
 
  If index>= 0 And *lst <> #NULL And index < CardinalListe(*lst)
   
    PremierElement(*lst)
   
    While index > 0
      ElementSuivant(*lst)
      index - 1
    Wend
   
    *elm = *lst\courant\element
   
  EndIf
 
  ProcedureReturn *elm
EndProcedure

Procedure AjouterElement(*lst.Liste, *ptr.l)
  Protected *elm.Element
 
  If *lst = #NULL Or *ptr = #NULL
    *elm = #NULL
  Else
    *elm = AllocateMemory(SizeOf(Element) + *lst\taille)
  EndIf
 
  If *elm <> #NULL
   
    *elm\element = AllocateMemory(*lst\taille)
   
    If *elm\element <> #NULL
     
      If *lst\courant <> #NULL
        While *lst\courant\suivant <> #NULL
          *lst\courant = *lst\courant\suivant
        Wend
      EndIf
     
      *elm\precedent = *lst\courant
      *elm\suivant = #NULL
      CopyMemory(*ptr, *elm\element, *lst\taille)
     
      If *lst\courant <> #NULL
        *lst\courant\suivant = *elm
      EndIf
      *lst\courant = *elm
     
    EndIf
   
  Else
 
    FreeMemory(*elm)
   
  EndIf
 
  ProcedureReturn *elm\element
EndProcedure

Procedure SupprimerElement(*lst.Liste)
  Protected *elm.Element, cardinal.l
 
  *elm = #NULL
 
  If *lst <> #NULL And *lst\courant <> #NULL
   
    cardinal = CardinalListe(*lst)
   
    If cardinal = 1
     
      FreeMemory(*lst\courant)
      *lst\courant = #NULL
     
    Else
     
      If *lst\courant\precedent <> #NULL
        *elm = *lst\courant\precedent
        *elm\suivant = *lst\courant\suivant
      EndIf
     
      If *lst\courant\suivant <> #NULL
        *elm = *lst\courant\suivant
        *elm\precedent = *lst\courant\precedent
      EndIf
     
      *elm = *lst\courant
     
      If *lst\courant\precedent <> #NULL
        *lst\courant = *lst\courant\precedent
      Else
        *lst\courant = *lst\courant\suivant
      EndIf
     
      FreeMemory(*elm)
      *elm = *lst\courant\element
   
    EndIf
   
  EndIf
 
  ProcedureReturn *elm
EndProcedure

Procedure ModifierElement(*lst.Liste, *ptr)

  If *lst <> #NULL And *lst\courant <> #NULL
    CopyMemory(*ptr, *lst\courant\element, *lst\taille)
  EndIf
 
EndProcedure

Procedure RecupererElement(*lst.Liste)
  Protected *elm.l
 
  *elm = #NULL
 
  If *lst <> #NULL And *lst\courant <> #NULL
    *elm = *lst\courant\element
  EndIf
 
  ProcedureReturn *elm
EndProcedure

Procedure PremierElement(*lst.Liste)
  Protected *elm.Element
 
  *elm = #NULL
 
  If *lst <> #NULL And *lst\courant <> #NULL
   
    While *lst\courant\precedent <> #NULL
      *lst\courant = *lst\courant\precedent
    Wend
   
    *elm = *lst\courant\element
   
  EndIf
 
  ProcedureReturn *elm
EndProcedure

Procedure ElementPrecedent(*lst.Liste)
  Protected *elm.Element
 
  *elm = #NULL
 
  If *lst <> #NULL And *lst\courant <> #NULL
   
    *elm = *lst\courant\precedent
   
    If *elm <> #NULL
      *lst\courant = *elm
    EndIf
   
    *elm = *lst\courant\element
   
  EndIf
 
  ProcedureReturn *elm
EndProcedure

Procedure ElementSuivant(*lst.Liste)
  Protected *elm.Element
 
  *elm = #NULL
 
  If *lst <> #NULL And *lst\courant <> #NULL
   
    *elm = *lst\courant\suivant
   
    If *elm <> #NULL
      *lst\courant = *elm
    EndIf
   
    *elm = *lst\courant\element
   
  EndIf
 
  ProcedureReturn *elm
EndProcedure

Procedure DernierElement(*lst.Liste)
  Protected *elm.Element
 
  *elm = #NULL
 
  If *lst <> #NULL And *lst\courant <> #NULL
   
    While *lst\courant\suivant <> #NULL
      *lst\courant = *lst\courant\suivant
    Wend
   
    *elm = *lst\courant\element
   
  EndIf
 
  ProcedureReturn *elm
EndProcedure

Procedure PourChaqueElement(*lst.Liste, *fct.l)
  Protected index.l
 
  If *lst <> #NULL And *lst\courant <> #NULL
    index = IndexListe(*lst)
   
    PremierElement(*lst)
   
    While *lst\courant <> #NULL
      CallFunctionFast(*fct, *lst\courant\element)
      *lst\courant = *lst\courant\suivant
    Wend
   
    SelectionnerElement(*lst, index)
  EndIf
 
EndProcedure

Procedure EchangerElements(*lst.Liste, index1.l, index2.l)
  Protected *elm1.Element, *elm2.Element, cardinal.l, index.l
 
  If index1 <> index2 And index1 >= 0 And index2 >= 0 And *lst <> #NULL
    index = IndexListe(*lst)
    cardinal = CardinalListe(*lst)
   
    If index1 < cardinal And index2 < cardinal
     
      SelectionnerElement(*lst, index1)
      *elm1 = *lst\courant\element
     
      SelectionnerElement(*lst, index2)
      *elm2 = *lst\courant\element
     
      Swap( *elm1, *elm2, SizeOf(*lst\taille) )
     
    EndIf
   
    SelectionnerElement(*lst, index)
  EndIf
 
EndProcedure

;-Test maListe...

maListe.l = CreerListe( SizeOf(COORD) )
tmp.COORD

For i = 1 To 5
  tmp\x = i
  tmp\y = i*10
  AjouterElement(maListe, tmp)
Next i

EchangerElements(maListe, 0, 2)

Procedure AfficherCoord(*ptr.Coord)
  Debug *ptr\x
  Debug *ptr\y
  Debug " "
EndProcedure

PourChaqueElement( maListe, @AfficherCoord() )