Liste chainé dynamique

[Anonyme]

Qui n'a pas pensé à un tel code :

Structure MaStruct
Newlist MaListe()
MaVariable.l
etc.c
...
endstructure

Malheureusement , c'est un manque dans purebasic , mais heureusement qu'il existe les pointeurs pour s'en sortir.
voici du code qui simplifie énormément la tâche :


LISTE DES COMMANDES :

*MaListe.Array = NewArray()
Création d'une nouvelle liste , *MaListe.Array peut être au sein d'une structure , mais la macro NewArray() doit être appeler obligatoirment !

PrevArrayElement(*A.Array)
Sélectionne l'élément précédent , pas de risque de dépassement.


NextArrayElement(*A.Array)
Sélectionne l'élément suivant , pas de risque de dépassement.

FirstArrayElement(*A.Array)
Sélectionne le 1° élément de la liste

LastArrayElement(*A.Array)
Sélectionne le dernier élément de la liste

AddArrayElement(*A.Array,Element.l)
Ajoute un élément à la fin de la liste

SelectArrayElement(*A.Array,Index.l)
Sélectionne l'élément par son emplacement dans la liste (index)

DeleteArrayElement(*A.Array,DeleteObject=#False)
Efface un élément de la liste , si DeleteObject = #true , l'objet contenu est aussi effacé.

SwapArrayElement(*A.Array,IndexA,IndexB)
Inverse 2 éléments.

GetCurrentArrayPtr(*A.Array)
Renvois l'élément selectionné

DebugArrayList(*A.Array)
Affiche la liste via la fenetre de debug.

SOURCE :

Code : Tout sélectionner

;#---------------------------------------------------------------------
;#	LISTE DOUBLEMENT CHAINEE DYNAMIQUE
;#	  PUREBASIC 4.2 LINUXx86 Ubuntu
;#
;# PAR CPL.BATOR
;#---------------------------------------------------------------------

Structure	ArrayNode
	*Left
	*Right
	Ptr.l
EndStructure

Structure	Array
	*List.ArrayNode	;First	element
	NbElement.l
EndStructure

Macro	NewNode()
AllocateMemory(SizeOf(ArrayNode))
EndMacro

Macro	NewArray()
AllocateMemory(SizeOf(Array))
EndMacro

;----------------------------------------------------------------------------------------------------------
;
;----------------------------------------------------------------------------------------------------------
Procedure	PrevArrayElement(*A.Array)
	With	*A
		If	\list\left<>-1
			\list=\list\left
				ProcedureReturn	1
					ElseIf	\list\left=-1
				ProcedureReturn	-1
			EndIf
	EndWith
EndProcedure
;----------------------------------------------------------------------------------------------------------
;
;----------------------------------------------------------------------------------------------------------
Procedure	NextArrayElement(*A.Array)
	With	*A
		If	\list\right<>-1
			\list=\list\right
				ProcedureReturn	1
					ElseIf	\list\right=-1
				ProcedureReturn	-1
			EndIf
	EndWith
EndProcedure
;----------------------------------------------------------------------------------------------------------
;
;----------------------------------------------------------------------------------------------------------
Procedure	FirstArrayElement(*A.Array)
While	Q<>-1
Q=PrevArrayElement(*A)
Wend
*A\list=*A\list\right
EndProcedure
;----------------------------------------------------------------------------------------------------------
;
;----------------------------------------------------------------------------------------------------------
Procedure	LastArrayElement(*A.Array)
While	Q<>-1
Q=NextArrayElement(*A)
Wend
EndProcedure
;----------------------------------------------------------------------------------------------------------
;
;----------------------------------------------------------------------------------------------------------
Procedure	AddArrayElement(*A.Array,Element.l)
With	*A

If	\NbElement=0		
	\list			=	NewNode()	
	\list\Ptr=-1
	\list\left=-1
	Else
		LastArrayElement(*A)
EndIf
		
;On	alloue	le	prochain	�l�ment
\List\Right	=	NewNode()

*NE.ArrayNode=\List\Right
*NE\Right=-1
*NE\Ptr=Element
*NE\left=\list
\list=*NE

\NbElement+1
EndWith
EndProcedure
;----------------------------------------------------------------------------------------------------------
;
;----------------------------------------------------------------------------------------------------------
Procedure	SelectArrayElement(*A.Array,Index.l)
FirstArrayElement(*A)
For	i	=	0	To	Index-2
	NextArrayElement(*A)
Next
EndProcedure
;----------------------------------------------------------------------------------------------------------
;
;----------------------------------------------------------------------------------------------------------
Procedure	DeleteArrayElement(*A.Array,DeleteObject=#False)

*R.ArrayNode	=	*A\List\Right
*L.ArrayNode	=	*A\List\Left

;on	fait	la	jonctions	des	membres	lat�raux
If	*A\List\Right<>-1:*R\Left=*L:EndIf
If	*A\List\Left<>-1:*L\Right=*R:EndIf
Left=*A\List\Left


If	DeleteObject=#True
FreeMemory(*A\List\Ptr)
EndIf

FreeMemory(*A\List)

*A\List	=Left

EndProcedure
;----------------------------------------------------------------------------------------------------------
;
;----------------------------------------------------------------------------------------------------------
Procedure	SwapArrayElement(*A.Array,IndexA,IndexB)
	SelectArrayElement(*A,IndexA)
		*LA.ArrayNode=*A\List
			SelectArrayElement(*A,IndexB)
		*LB.ArrayNode=*A\List
	Swap	*LA\ptr,*LB\ptr
EndProcedure
;----------------------------------------------------------------------------------------------------------
;
;----------------------------------------------------------------------------------------------------------
Procedure.l	GetCurrentArrayPtr(*A.Array)
ProcedureReturn	*A\List\Ptr
EndProcedure
;----------------------------------------------------------------------------------------------------------
;
;----------------------------------------------------------------------------------------------------------
Procedure	DebugArrayList(*A.Array)

FirstArrayElement(*A)

Debug	""
Debug	"##############"
Debug	"#DEBUT	DE	LA	LISTE	#"
Debug	"##############"
Debug	""
While	Q<>-1
Debug	"ELEMENT	PRECEDENT	=	"+Str(*A\List\Left)	+	"		ELEMENT	COURANT	=	"+Str(*A\List)+	"	ELEMENT	SUIVANT	=	"+Str(*A\List\Right)+"	Valeur	pointeur	::	"+Str(*A\List\Ptr)
Q=NextArrayElement(*A)
Wend
Debug	""
Debug	"############"
Debug	"#FIN	DE	LA	LISTE	#"
Debug	"############"
Debug	""


EndProcedure
;----------------------------------------------------------------------------------------------------------
;
;----------------------------------------------------------------------------------------------------------

EXEMPLE :

Voici l'exemple ou un Heros possède une liste d'objet , il peut y avoir plusieurs heros , plusieurs objets...
dans l'exemple un seul heros avec 3 objets.

Code : Tout sélectionner

;voici une liste d'objet possible.
;C'est pas la meilleur façon de faire , mais c'est pour illustrer 
; l'utilisation des Array's 
; Donc, 3 objet , une epee , du jaune , un flingue...

Structure OBJET
	Nom$
	Vie.f
EndStructure


Sabre.Objet
Sabre\Nom$="Epee de la mort qui tue..."
Sabre\Vie=0.5

Potion.Objet
Potion\Nom$="Pastis51"
Potion\Vie=250

Pistolet.Objet
Pistolet\Nom$="Magnum357"
Pistolet\Vie=125.8



;Notre Hero possède une liste d'objet
Structure	HERO
	*ListeObjet.Array	
EndStructure


; Bernard est notre heros
BERNARD.HERO 
;On initialise la liste de la structure HERO
BERNARD\ListeObjet = NewArray()

; On lui donne un flingue 
AddArrayElement(BERNARD\ListeObjet,@Pistolet) ; On passe le pointeur de Pistolet dans la liste
; On lui donne deux jaunes , il aime bien la tisane ,c'est une gueule à fioul notre Bernard...
AddArrayElement(BERNARD\ListeObjet,@Potion) ; idem,on passe le pointeur
AddArrayElement(BERNARD\ListeObjet,@Potion) 
; Et une épée...
AddArrayElement(BERNARD\ListeObjet,@Sabre)  



; Voila bernard est équipé , je veut connaitre la vie du 4°	élément maintenant
SelectArrayElement(BERNARD\ListeObjet,4) ; on selectionne donc le 2� �l�ment
*OBJET_TEMPORAIRE.OBJET = GetCurrentArrayPtr(BERNARD\ListeObjet); Notre objet Temporaire est en quelque sorte une r�f�rence de l'objet.
Debug "VIE DU 4° ELEMENT : "+StrF(*OBJET_TEMPORAIRE\Vie)
Debug "NOM	DU 4° ELEMENT=	"+*OBJET_TEMPORAIRE\Nom$

;Il n'a pas besoin d'une épée , on la vire... , meme dans le jeu elle ne sert pas , je supprime aussi l'objet en plus de l'element
LastArrayElement(BERNARD\ListeObjet)
DeleteArrayElement(BERNARD\ListeObjet) ; Sabre.Objet n'est donc plus valide !!!!

Debug	""
Debug	""
Debug	""

;on résume la liste a nanar
Debug	"LISTE	DOBJET	A	BERNARD"
FirstArrayElement(BERNARD\ListeObjet)
Debug	""
While NextE<>-1
c+1
Debug	"ITEM	N°"+Str(c)
*OBJET_TEMPORAIRE.OBJET = GetCurrentArrayPtr(BERNARD\ListeObjet)
Debug "NOM=="+*OBJET_TEMPORAIRE\Nom$
Debug "VIE=="+StrF(*OBJET_TEMPORAIRE\Vie)
NextE=NextArrayElement(BERNARD\ListeObjet)
Debug	""
Debug	""
Wend 

[Cls]

Très intéressant, je stocke dans ma besace

[poshu]

Extrait du forum anglais, le code + un exemple.

Code : Tout sélectionner

Macro GlobalNewDynamicListPointer(Name, Type)
  If 0
    Global NewList Name.Type()
  EndIf
EndMacro

Macro NewDynamicListPointer(Name, Type)
  If 0
    NewList Name.Type()
  EndIf
EndMacro

Macro BindListTemplate(Type)
  Procedure BindList#Type(List.Type(), ID.q)
    !mov eax, [p.v_ID]
    !mov edx, [p.v_ID+4]
    !mov ecx, [p.v_ID-4]
    !mov [ecx], eax
    !add ecx, 4
    !mov [ecx], edx
  EndProcedure
EndMacro

Macro DynamicNewListTemplate(Type)
  Procedure.q DynamicNewList#Type()
    Protected NewList Local.Type()
    !mov eax, [esp]
    !mov edx, [esp+4]
    !add esp, 8
    !ret
  EndProcedure
EndMacro

Macro FreeListTemplate(Type)
  Procedure FreeList#Type(ID.q)
    If 0
      NewList Dummy.Type()
    EndIf
    BindList#Type(Dummy(), ID.q)
  EndProcedure
EndMacro

Macro UseListType(Type)
  BindListTemplate(Type)
  DynamicNewListTemplate(Type)
  FreeListTemplate(Type)
EndMacro

;************************************************************
;Example of an array of linked lists of strings. It assumes that the code above is included.
;************************************************************

Code:
UseListType(S) ; Generate functions with postfix S for string type
; UseListType(L) ; Generate functions with postfix L for long type

#ArrayLen = 10
; Allocate array
Dim ListArray.q(#ArrayLen) ; Notice that ListArray is of type .q. It can
; store lists of any type.

; Create a dummy list ("list name") to represent the dynamic lists
; Global means that NAME is global. The dynamic LISTS you create are
; always global. Later you use a dynamically created list by binding the
; name to a list. So you don't have to create 1000 names to work with
; 1000 dynamic lists.
GlobalNewDynamicListPointer(Dummy, s) ; Notice that names are typed.

; Fill array with LinkedLists
For I = 0 To #ArrayLen
  ListArray(I) = DynamicNewListS()
Next

; Fill those LinkedLists with some gibberish
For I = 0 To #ArrayLen
  BindListS(Dummy(), ListArray(I))
  For J = 0 To I
    AddElement(Dummy())
    Dummy() = Str(J) + "_"
  Next
Next

BindListS(Dummy(), ListArray(9))
SortList(Dummy(), 1)

; Print each LinkedList. Notice that ForEach can be used
; for the individual lists, but obviously not for the
; array
For I = 0 To #ArrayLen
  Debug "------------ " + Str(I) + " ------------"
  BindListS(Dummy(), ListArray(I))
  ForEach Dummy()
    Debug Dummy()
  Next
Next 

Ca fait donc des listes chainées natives dynamiques... Bon, je m'en suis pas servi depuis, houlalala, un an au moins, mais dans mon souvenir, c'était très bien.

[lionel_om]

Les deux codes ci-dessus ont des problèmes :

Cpl.Bator :
Tout n'est pas réalloué : les Strings par exemple. Donc si on modifie l'objet initial qui a permis de créer l'objet à la LL, l'objet de la LL est aussi modifié !
Par exemple, rajoute :

Code : Tout sélectionner

Pistolet\Nom$="ca marche pas !!!"

avant les Debug... "ca marche pas !!!" sera affiché...

Poshu :
J'ai l'impression qu'il faut redéfinir des fonctions pour chaque Liste: "NewList dummy()" est dans une des fonctions en début de fichier... donc il faut réécrire cette fonction pour chaque nouvelle liste... Et en plus seuls les types de bases ont l'air d'être pris en compte.

Je viens de mettre à jour ma LIB Vector : voir le topic. 59 fonctions permettent de gagner pas mal de temps... Et comme le disait Cpl.Bator :

mais heureusement qu'il existe les pointeurs pour s'en sortir.

[Anonyme]

Code : Tout sélectionner

Tout n'est pas réalloué : les Strings par exemple. Donc si on modifie l'objet initial qui a permis de créer l'objet à la LL, l'objet de la LL est aussi modifié ! 

Oui , c'est le but. c'est une liste de référence en quelque sorte. Donne moi un exemple ou cela pose des problèmes.

l'objet de la LL est aussi modifié !

C'est en partie faux , car la LL ne contient que des pointeurs , pas de valeur quelconque.
Il est toujours possible de faire une copié de la source du pointeur.

Ta lib , ma posé des problèmes sous nux ( les sources ) ne fonctionne pas. j'ai des erreurs de tout les coté.

[poshu]

Il me semble que j'utilisais des structures avec cet include... Bon, toujours est il que faut aller voir ici pour plus de détail.

[lionel_om]

Code : Tout sélectionner

Tout n'est pas réalloué : les Strings par exemple. Donc si on modifie l'objet initial qui a permis de créer l'objet à la LL, l'objet de la LL est aussi modifié ! 

Oui , c'est le but. c'est une liste de référence en quelque sorte. Donne moi un exemple ou cela pose des problèmes.

Bah si tu utilise le même object : *mon_objet.Object, pour ajouter tous les objets à la liste. Là ca va car tu utilise des objets différents, mais un gros programme tu vas gérélement utiliser une BDD ou un fichier PREFS/SAV pour y importer les données. Bah dans ce cas, les Strings seront désalloués par PB et tu vas avoir des plantages...

l'objet de la LL est aussi modifié !

C'est en partie faux , car la LL ne contient que des pointeurs , pas de valeur quelconque.
Il est toujours possible de faire une copié de la source du pointeur.

J'ai pas tout compris...

Ta lib , ma posé des problèmes sous nux ( les sources ) ne fonctionne pas. j'ai des erreurs de tout les coté.

Ah oué ? La dernière version ? Quel genre ? Sous Nux faut sans doute recompiler le fichier Res... Il est pas à jour. C'est quelqu'un du forum anglais qui m'avait filé et j'ai fait des modifs entre temps.

Etant donné que je n'ai pas Linux et peut de retour sur cette Lib, je n'ai pris le temps de demander à qq1 de me le compiler (et j'ai oublié de le notifier...).
Si ce n'ai pas ça, peux-tu m'en dire plus pour que je fixe ça ?

Car personnellement je m'en sers tout le temps et dès que je trouve un bug, je le corrige aussitôt ou j'implémente de nouvelles fonctions...

/Lio

[Anonyme]

J'ai pas tout compris... Confused

C'est pourtant très simple


La liste ne duplique pas les éléments passé en mémoire :

ex :

A$ = "Coucou"
AddArrayElement(A$) <----- A$ n'est pas dupliqué , si tu modifie A$ à partir de la liste , le A$ d'origine sera modifié aussi !

La liste n'est en fait qu'une serie de noeud de pointeur ,

Voici un noeud :

*Noeud_Gauche_Ptr *ValeurPointé *Noeud_Droite_Ptr

Donc , quand tu attribue un élément à une liste , il y a seulement le pointeur de la variable qui se trouve dans *ValeurPointé

en reprenant l'exemple plus haut , ca nous fait donc :


A$ = "Coucou"
AddArrayElement(A$)

Donc le noeud du premier élément resemble a ceci :

-1 @A$ *Noeud_Droite_Ptr

Note le @A$ , qui est l'adresse de A$ , et non pas une nouvelle variable comme tu le sous entend

Voilà , j'éspère , avoir été clair a 2h du mat avec 2 grammes dans chaque paupières....
c'est pas évident d'expliquer un concept de prog , si ta pas pigé , je te ferais un jolie schéma plus tard lio.

Code : Tout sélectionner

Ah oué ? La dernière version ? Quel genre ?

1° erreur , la constante #MB_ICON_machin , c'est du windows
une fois corrigé , il me dit qu'il n'y a pas d'élément dans une liste , je sais plus laquelle , je ne suis pas allé plus loin , j'ai préférer recodé un truc à ma sauce

[lionel_om]

Oui c'est bon je comprends là. Si c'est ce que tu voulais faire ok.
Mais moi j'ai plutot l'habitude de voir des choses comme ça :

Code : Tout sélectionner

Objet1.Object
hFile = OpenFile(#PB_ANY, "file.dat")
While Eof(hFile) = #Null
  Object1\FieldInt = ReadLong(hFile)
  Object1\FieldStr = ReadString(hFile)
Wend

Là ca va marcher au début, puis normalement PB va désallouer la mémoire des Strings et ca va planter...

1° erreur , la constante #MB_ICON_machin , c'est du windows
une fois corrigé , il me dit qu'il n'y a pas d'élément dans une liste , je sais plus laquelle , je ne suis pas allé plus loin , j'ai préférer recodé un truc à ma sauce

Ah oui. Je ne savais pas que c'était que pour Windows... C'est la Constante #MB_ICONERROR. Elle est utilisée ici (ligne 47) :

Code : Tout sélectionner

Procedure Vector__RaiseError(Message$, Function$ = #Null$, Flag = #MB_ICONERROR)

Y'a-t'il une constante sous Nux qui soit équivalente à celle-ci ? (pour qu'un MessageRequester affiche l'icône d'erreur).

/Lio

[cederavic]

Déterrage de 3 ans pour contribution
J'avais besoin de ton super code CPL mais sauce POO... Voici donc le résultat :
Fichier : Array.classheader

Code : Tout sélectionner

;""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
; PureBasic 4.60
; Auteur original : CPL.BATOR    voir (http://www.purebasic.fr/french/viewtopic.php?f=6&t=8401)
; Modifications : Cederavic
; Class Header Liste doublement chainée dynamique
;""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
;- Header Class Array.

Structure ArrayNode
  *left
  *right
  ptr.i
EndStructure

;- Membres
Structure  MembersArray
  *vTable.i
  *list.ArrayNode   ;First   element
  nbElement.i
EndStructure

;- Methodes
Interface ClassArray
  PrevElement.b()
  NextElement.b()
  FirstElement()
  LastElement()
  AddElement(element.i)
  SelectElement(index.i)
  DeleteElement(deleteObject.b = #False)
  SwapElement(indexA.i, indexB.i)
  GetCurrentPtr()
  Debug()
  Destroy(deleteObject.b = #False)
EndInterface
;""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

Fichier : Array.class

Code : Tout sélectionner

;""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
; PureBasic 4.60
; Auteur original : CPL.BATOR    voir (http://www.purebasic.fr/french/viewtopic.php?f=6&t=8401)
; Modifications : Cederavic
; Class Liste doublement chainée dynamique
;""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
;- Class Array.

;-Constructeur
;*****
;- *PtrMembersArray NewArray()
; -----
; Créer une nouvelle instance de la class Array
; -----
; IN  : 
;
; OUT : *PtrMembersArray : Instance de la class
Procedure.i NewArray()
  Protected *object.MembersArray
  
  *object = AllocateMemory(SizeOf(MembersArray))
  If *object
    *object\vTable = ?VTable_ClassArray
  EndIf

  ProcedureReturn *object
EndProcedure

;*****
;- Byte PrevElement()
; -----
; Sélectionne l'élément précédent , pas de risque de dépassement. 
; -----
; IN  : 
;
; OUT : Byte = 1 s'il existe, sinon -1
Procedure.b ClassArray_PrevElement(*this.MembersArray)

  If *this\list\left <> -1
    *this\list = *this\list\left
    ProcedureReturn 1
  ElseIf *this\list\left = -1
    ProcedureReturn -1
  EndIf

EndProcedure

;*****
;- Byte NextElement()
; -----
; Sélectionne l'élément suivant , pas de risque de dépassement.
; -----
; IN  : 
;
; OUT : Byte = 1 s'il existe, sinon -1
Procedure.b ClassArray_NextElement(*this.MembersArray)
  
  If *this\list\right <> -1
    *this\list = *this\list\right
    ProcedureReturn 1
  ElseIf *this\list\right = -1
    ProcedureReturn -1
  EndIf
  
EndProcedure

;*****
;- FirstElement()
; -----
; Sélectionne le 1° élément de la liste
; -----
; IN  : 
;
; OUT : 
Procedure ClassArray_FirstElement(*this.MembersArray)
  Protected q.i
  
  While q <> -1
    q = ClassArray_PrevElement(*this)
  Wend
  *this\list = *this\list\right
  
EndProcedure

;*****
;- LastElement()
; -----
; Sélectionne le dernier élément de la liste
; -----
; IN  : 
;
; OUT : 
Procedure ClassArray_LastElement(*this.MembersArray)
  Protected q.i
  
  While q <> -1
    q = ClassArray_NextElement(*this)
  Wend

EndProcedure

;*****
;- AddElement(*PtrInteger element)
; -----
; Ajoute un élément à la fin de la liste
; -----
; IN  : *PtrInteger element = Elément à ajouter
;
; OUT : 
Procedure ClassArray_AddElement(*this.MembersArray, element.i)
  Protected *ne.ArrayNode
  
  If *this\nbElement = 0      
    *this\list      = AllocateMemory(SizeOf(ArrayNode))   
    *this\list\ptr  = -1
    *this\list\left = -1
  Else
    ClassArray_LastElement(*this)
  EndIf
        
  ;On alloue le prochain élément
  *this\list\right = AllocateMemory(SizeOf(ArrayNode))
  
  *ne.ArrayNode = *this\list\right
  *ne\right     = -1
  *ne\ptr       = element
  *ne\left      = *this\list
  *this\list    = *ne
  
  *this\nbElement + 1

EndProcedure

;*****
;- SelectElement(Integer index)
; -----
; Sélectionne l'élément par son emplacement dans la liste (index)
; -----
; IN  : Integer index = Index de l'élément à sélectionner
;
; OUT : 
Procedure ClassArray_SelectElement(*this.MembersArray, index.i)
  Protected i.i
  
  ClassArray_FirstElement(*this)
  For i = 0  To index - 2
    ClassArray_NextElement(*this)
  Next
  
EndProcedure

;*****
;- DeleteElement(Boolean deleteObject)
; -----
; Efface un élément de la liste
; -----
; IN  : Boolean deleteObject = si deleteObject = #true , l'objet contenu est aussi effacé (deleteObject = #False par défaut)
;
; OUT : 
Procedure ClassArray_DeleteElement(*this.MembersArray, deleteObject.b = #False)

  Protected *r.ArrayNode = *this\list\right
  Protected *l.ArrayNode = *this\list\left
  Protected left.i
  
  ;on fait la jonctions des membres latéraux
  If *this\list\right <> -1 : *r\left   = *l : EndIf
  If *this\list\left  <> -1 : *l\right  = *r : EndIf
  left = *this\list\left
  
  If deleteObject = #True
    FreeMemory(*this\list\ptr)
  EndIf
  
  FreeMemory(*this\list)
  
  *this\list = Left

EndProcedure

;*****
;- SwapElement(Integer indexA, Integer indexB)
; -----
; Inverse 2 éléments.
; -----
; IN  : Integer indexA = 1er élément à inverser
;       Integer indexB = 2nd élément à inverser
;
; OUT : 
Procedure ClassArray_SwapElement(*this.MembersArray, indexA.i , indexB.i)
  Protected *lA.ArrayNode
  Protected *lB.ArrayNode
  
  ClassArray_SelectElement(*this, indexA)
  *lA = *this\list
  
  ClassArray_SelectElement(*this, indexB)
  *lB = *this\list
  
  Swap *lA\ptr, *lB\ptr
  
EndProcedure

;*****
;- *PtrInteger NewWindowEvent()
; -----
; Renvois l'élément sélectionné
; -----
; IN  : 
;
; OUT : *PtrInteger = Pointeur vers le contenu de l'élément sélectionné
Procedure.i ClassArray_GetCurrentPtr(*this.MembersArray)
  ProcedureReturn *this\list\ptr
EndProcedure

;*****
;- Debug()
; -----
; Affiche la liste via la fenetre de debug.
; -----
; IN  : 
;
; OUT : 
Procedure ClassArray_Debug(*this.MembersArray)
  Protected q.i
  
  ClassArray_FirstElement(*this)
  
  Debug ""
  Debug "##############"
  Debug "#DEBUT   DE   LA   LISTE   #"
  Debug "##############"
  Debug ""
  While q <> -1
  Debug "ELEMENT PRECEDENT = " + Str(*this\list\left) + "   ELEMENT COURANT = " + Str(*this\list) + " ELEMENT SUIVANT = " + Str(*this\list\right) + " Valeur pointeur :: " + Str(*this\list\ptr)
    q = ClassArray_NextElement(*this)
  Wend
  Debug ""
  Debug "############"
  Debug "#FIN   DE   LA   LISTE   #"
  Debug "############"
  Debug ""
  

EndProcedure

;*****
;- Destroy()
; -----
; Supprime l'instance de la class et son contenu
; -----
; IN  : Boolean deleteObject = si True, supprime le contenu
;
; OUT : 
Procedure ClassArray_Destroy(*this.MembersArray, deleteObject = #False)
  Protected index.i
  
  ClassArray_FirstElement(*this)
  
  While index <> -1
    index = ClassArray_NextElement(*this)
    ClassArray_DeleteElement(*this, deleteObject)
  Wend
  
  FreeMemory(*this)
  
EndProcedure

;""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
;-VIRTUAL TABLES.

DataSection 
  VTable_ClassArray: 
  Data.i @ClassArray_PrevElement()
  Data.i @ClassArray_NextElement()
  Data.i @ClassArray_FirstElement()
  Data.i @ClassArray_LastElement()
  Data.i @ClassArray_AddElement()
  Data.i @ClassArray_SelectElement()
  Data.i @ClassArray_DeleteElement()
  Data.i @ClassArray_SwapElement()
  Data.i @ClassArray_GetCurrentPtr()
  Data.i @ClassArray_Debug()
  Data.i @ClassArray_Destroy()
EndDataSection

;""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

Fichier : Exemple_Array.pb

Code : Tout sélectionner

;voici une liste d'objet possible.
;C'est pas la meilleur façon de faire , mais c'est pour illustrer
; l'utilisation des Array's
; Donc, 3 objet , une epee , du jaune , un flingue...


XIncludeFile("Array.classheader")
XIncludeFile("Array.class")

Structure OBJET
   Nom$
   Vie.f
EndStructure

Sabre.Objet
Sabre\Nom$="Epee de la mort qui tue..."
Sabre\Vie=0.5

Potion.Objet
Potion\Nom$="Pastis51"
Potion\Vie=250

Pistolet.Objet
Pistolet\Nom$="Magnum357"
Pistolet\Vie=125.8

;Notre Hero possède une liste d'objet
Structure   HERO
   *ListeObjet.ClassArray   
EndStructure

; Bernard est notre heros
BERNARD.HERO
;On initialise la liste de la structure HERO
BERNARD\ListeObjet = NewArray()

; On lui donne un flingue
BERNARD\ListeObjet\AddElement(@Pistolet) ; On passe le pointeur de Pistolet dans la liste
; On lui donne deux jaunes , il aime bien la tisane ,c'est une gueule à fioul notre Bernard...
BERNARD\ListeObjet\AddElement(@Potion) ; idem,on passe le pointeur
BERNARD\ListeObjet\AddElement(@Potion)
; Et une épée...
BERNARD\ListeObjet\AddElement(@Sabre) 



; Voila bernard est équipé , je veut connaitre la vie du 4°   élément maintenant
BERNARD\ListeObjet\SelectElement(4) ; on selectionne donc le 2eme élément
*OBJET_TEMPORAIRE.OBJET = BERNARD\ListeObjet\GetCurrentPtr(); Notre objet Temporaire est en quelque sorte une référence de l'objet.
Debug "VIE DU 4° ELEMENT : " + StrF(*OBJET_TEMPORAIRE\Vie)
Debug "NOM DU 4° ELEMENT = " + *OBJET_TEMPORAIRE\Nom$

;Il n'a pas besoin d'une épée , on la vire... , meme dans le jeu elle ne sert pas , je supprime aussi l'objet en plus de l'element
BERNARD\ListeObjet\LastElement()
BERNARD\ListeObjet\DeleteElement() ; Sabre.Objet n'est donc plus valide !!!!

Debug   ""
Debug   ""
Debug   ""

;on résume la liste a nanar
Debug   "LISTE   DOBJET   A   BERNARD"
BERNARD\ListeObjet\FirstElement()
Debug   ""
While NextE <> -1
  c + 1
  Debug   "ITEM   N°"+Str(c)
  *OBJET_TEMPORAIRE.OBJET = BERNARD\ListeObjet\GetCurrentPtr()
  Debug "NOM==" + *OBJET_TEMPORAIRE\Nom$
  Debug "VIE==" + StrF(*OBJET_TEMPORAIRE\Vie)
  NextE = BERNARD\ListeObjet\NextElement()
  Debug   ""
  Debug   ""
Wend 

BERNARD\ListeObjet\Destroy()

[G-Rom]

sympathique l'adaptation, l'exemple illustre bien la différence.
il aime toujours autant le pastaga le nanard...

[Fred]

A noter que c'est nativement supporté par PB maintenant.

[cederavic]

Chiotte je suis passé à coté... Merci Fred =)

[G-Rom]

Tu blagues ?
Sinon ca fait un bail que l'on ta pas vu , ta des nouvelles de Polux & de sa team ?

[cederavic]

Ben je m'informe de temps en temps, je code toujours en PB pour 2-3 trucs, mais là je suis vraiment passé à coté :p

Pas de nouvelle Polux, Yukin et Djes... J'ai mal saisie la chance que BGames m'a offerte mais ça fait toujours une belle experience. J'espere que tout va bien pour eux

Et la famille ici comment elle va?