PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Template für Listen

https://www.purebasic.fr/german/viewtopic.php?t=16835

Seite 1 von 2

Template für Listen

Verfasst: 08.06.2008 17:50
von Josef Sniatecki
Hier habe ich mal ein Template womit man Listen erstellen kann.

Code: Alles auswählen

;/-----------------------------------------------------------------\
;|  *** List - template ***                                        |
;|    Created by Josef Sniatecki 2008.                             |
;\-----------------------------------------------------------------/



;/------------------------------------------\
;| Macros                                   |
;\------------------------------------------/

Macro _NItem(List,Item,PItem,Item_Mem)
  ;_NextItem(List,Item,PreviousItem,Item_Memory)
  
  Item=List_ItemN(List,PItem)
  Item_Mem=Item\Mem
EndMacro
Macro _PItem(List,Item,NItem,Item_Mem)
  ;_PreviousItem(List,Item,NextItem,Item_Memory)
  
  Item=List_ItemP(List,NItem)
  Item_Mem=Item\Mem
EndMacro
Macro _FItem(List,Item,Item_Mem)
  Item=List_ItemF(List)
  Item_Mem=Item\Mem
EndMacro
Macro _LItem(List,Item,Item_Mem)
  Item=List_ItemPokeL(List)
  Item_Mem=Item\Mem
EndMacro
Macro _DelItem(List,Item,Item_Mem)
  Item=List_DelItem(List,Item)
  Item_Mem=Item\Mem
EndMacro



;/------------------------------------------\
;| Structures                               |
;\------------------------------------------/

Structure List_Item
  ;List_Item
  
  *N.List_Item ;Next
  *P.List_Item ;Previous
  *Mem         ;Memory
EndStructure
Structure List
  ;List
  
  Item_MemSz.l     ;Item_MemorySize
  ItemAm.l         ;ItemAmount
  *FItem.List_Item ;FirstItem
  *LItem.List_Item ;LastItem
EndStructure



;/------------------------------------------\
;| Functions                                |
;\------------------------------------------/

Procedure.l List(Item_MemSz.l)
  ;List(Item_Memory_Size)
  ;{
  ;  Gibt einen Zeiger auf eine neue Liste zurück. Dabei muss die
  ;  größe der Items[Item_MemSz] bestimmt werden.
  ;}
  
  Protected *List.List
  
  *List=AllocateMemory(SizeOf(List))
  If *List
    *List\Item_MemSz=Item_MemSz
    ProcedureReturn *List
  EndIf
  ProcedureReturn #False
EndProcedure
Procedure.l DelList(*List.List,*Item_Mem_DelFunc=0)
  ;DeleteList(List,Item_Memory_DeleteFunction=0)
  ;{
  ;  Löscht die Liste[List] aus dem Speicher.
  ;}
  
  Protected *Item.List_Item 
  
  *Item=*List\FItem
  While *Item
    *List\FItem=*List\FItem\N
    
    If *Item_Mem_DelFunc
      If CallFunctionFast(*Item_Mem_DelFunc,*Item\Mem)=#False
        ProcedureReturn #False
      EndIf
    Else
      If FreeMemory(*Item\Mem)=#False
        ProcedureReturn #False
      EndIf
    EndIf
    If FreeMemory(*Item)=#False
      ProcedureReturn #False
    EndIf
    
    *Item=*List\FItem
  Wend
  If FreeMemory(*List)
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure
Procedure.l CopyList(*SList.List,*DList.List)
  ;CopyList(SoureList,DenistationList)
  ;{
  ;  Kopiert alle Daten der Skriptliste[SList] in die Zielliste[DList].
  ;}
  Protected *SItem.List_Item ;SourceItem
  Protected *DItem.List_Item ;DenistationItem
  
  *DList\Item_MemSz=*SList\Item_MemSz
  *DList\ItemAm=*SList\ItemAm
  
  *SItem=*SList\FItem
  While *SItem
    If *DItem
      *DItem\N=AllocateMemory(SizeOf(List_Item))
      If *DItem\N
        *DItem\N\P=*DItem
        *DItem=*DItem\N
        *DItem\Mem=AllocateMemory(*DList\Item_MemSz)
        If *DItem\Mem
          *DList\LItem=*DItem
        Else
          ProcedureReturn #False
        EndIf
      Else
        ProcedureReturn #False
      EndIf
    Else
      *DItem=AllocateMemory(SizeOf(List_Item))
      If *DItem
        *DItem\N=0
        *DItem\P=0
        *DItem\Mem=AllocateMemory(*DList\Item_MemSz)
        If *DItem\Mem
          CopyMemory(*SItem\Mem,*DItem\Mem,*DList\Item_MemSz)
          *DList\FItem=*DItem
          *DList\LItem=*DItem
        Else
          ProcedureReturn #False
        EndIf
      Else
        ProcedureReturn #False
      EndIf
    EndIf
    
    *SItem=*SItem\N
  Wend
  ProcedureReturn #True
EndProcedure
Procedure.l CleList(*List.List,*Item_Mem_DelFunc=0)
  ;ClearList(List,Item_Memory_DeleteFunction=0)
  ;{
  ;  Löscht alle Items aus der Liste[List].
  ;}
  
  Protected *Item.List_Item ;Item
  
  *List\ItemAm=0
  
  *Item=*List\FItem
  While *Item
    *List\FItem=*List\FItem\N
    
    If *Item_Mem_DelFunc
      If CallFunctionFast(*Item_Mem_DelFunc,*Item\Mem)=#False
        ProcedureReturn #False
      EndIf
    Else
      If FreeMemory(*Item\Mem)=#False
        ProcedureReturn #False
      EndIf
    EndIf
    If FreeMemory(*Item)=#False
      ProcedureReturn #False
    EndIf
    
    *Item=*List\FItem
  Wend
  
  *List\FItem=0
  *List\LItem=0
  ProcedureReturn #True
EndProcedure

Procedure.l List_Item(*List.List,*N.List_Item,*P.List_Item,*RetMem=0,*Mem=0)
  ;List_Item(List,Next,Previous,ReturnMemory=0,Memory=0)
  ;{
  ;  Fügt ein Item zwischen dem Nächsten-[N] und dem vorherigen Item[P] ein.
  ;  Falls verfügbar, werden die Daten[Mem] in das Item eingefügt.
  ;  Mit [RetMem] kann der Zeiger der neuen Daten erhalten werden.
  ;}
  
  Protected *Item.List_Item ;Item
  
  *Item=AllocateMemory(SizeOf(List_Item))
  If *Item
    If *N
      *Item\N=*N
      *N\P=*Item
    Else
      *List\LItem=*Item
    EndIf
    If *P
      *Item\P=*P
      *P\N=*Item
    Else
      *List\FItem=*Item
    EndIf
    If *Mem=0
      *Item\Mem=AllocateMemory(*List\Item_MemSz)
      If *Item\Mem=#False
        ProcedureReturn #False
      EndIf
    Else
      *Item\Mem=*Mem
    EndIf
    If *RetMem : PokeL(*RetMem,*Item\Mem) : EndIf
    *List\ItemAm+1
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure
Procedure.l List_ItemN(*List.List,*P.List_Item,*RetMem=0,*Mem=0)
  ;List_ItemAsNext(List,Previous,ReturnMemory=0,Memory=0)
  ;{
  ;  Fügt ein Item nach dem vorherigen Item[P] ein.
  ;  Falls verfügbar, werden die Daten[Mem] in das Item eingefügt.
  ;  Mit [RetMem] kann der Zeiger der neuen Daten erhalten werden.
  ;}
  
  Protected *Item.List_Item ;Item
  
  *Item=AllocateMemory(SizeOf(List_Item))
  If *Item
    If *P
      *Item\P=*P
      If *P\N
        *Item\N=*P\N
        *P\N\P=*Item
        *P\N=*Item
      Else
        *List\LItem=*Item
      EndIf
      *P\N=*Item
    Else
      *List\FItem=*Item
      *List\LItem=*Item
    EndIf
    If *Mem=0
      *Item\Mem=AllocateMemory(*List\Item_MemSz)
      If *Item\Mem=#False
        ProcedureReturn #False
      EndIf
    Else
      *Item\Mem=*Mem
    EndIf
    If *RetMem : PokeL(*RetMem,*Item\Mem) : EndIf
    *List\ItemAm+1
    ProcedureReturn *Item
  EndIf
  ProcedureReturn #False
EndProcedure
Procedure.l List_ItemP(*List.List,*N.List_Item,*RetMem=0,*Mem=0)
  ;List_ItemAsPrevious(List,Next,ReturnMemory=0,Memory=0)
  ;{
  ;  Fügt ein Item vor dem nächsten Item[N] ein.
  ;  Falls verfügbar, werden die Daten[Mem] in das Item eingefügt.
  ;  Mit [RetMem] kann der Zeiger der neuen Daten erhalten werden.
  ;}
  Protected *Item.List_Item ;Item
  
  *Item=AllocateMemory(SizeOf(List_Item))
  If *Item
    If *N
      *Item\N=*N
      If *N\P
        *Item\P=*N
        *N\P\N=*Item
        *N\P=*Item
      Else
        *List\FItem=*Item
      EndIf
    Else
      *List\FItem=*Item
      *List\LItem=*Item
    EndIf
    If *Mem=0
      *Item\Mem=AllocateMemory(*List\Item_MemSz)
      If *Item\Mem=#False
        ProcedureReturn #False
      EndIf
    Else
      *Item\Mem=*Mem
    EndIf
    If *RetMem : PokeL(*RetMem,*Item\Mem) : EndIf
    *List\ItemAm+1
    ProcedureReturn *Item
  EndIf
  ProcedureReturn #False
EndProcedure
Procedure.l List_ItemF(*List.List,*RetMem=0,*Mem=0)
  ;List_ItemAsFirst(List,ReturnMemory=0,Memory=0)
  ;{
  ;  Fügt ein Item an erster stelle der Liste[List] ein.
  ;  Falls verfügbar, werden die Daten[Mem] in das Item eingefügt.
  ;  Mit [RetMem] kann der Zeiger der neuen Daten erhalten werden.
  ;}
  Protected *Item.List_Item ;Item
  
  *Item=AllocateMemory(SizeOf(List_Item))
  If *Item
    If *List\FItem
      *Item\N=*List\FItem
      *List\FItem\P=*Item
      *List\FItem=*Item
    Else
      *List\FItem=*Item
      *List\LItem=*Item
    EndIf
    If *Mem=0
      *Item\Mem=AllocateMemory(*List\Item_MemSz)
      If *Item\Mem=#False
        ProcedureReturn #False
      EndIf
    Else
      *Item\Mem=*Mem
    EndIf
    If *RetMem : PokeL(*RetMem,*Item\Mem) : EndIf
    *List\ItemAm+1
    ProcedureReturn *Item
  EndIf
  ProcedureReturn #False
EndProcedure
Procedure.l List_ItemL(*List.List,*RetMem=0,*Mem=0)
  ;List_ItemAsLast(List,ReturnMemory=0,Memory=0)
  ;{
  ;  Fügt ein Item an letzter stelle der Liste[List] ein.
  ;  Falls verfügbar, werden die Daten[Mem] in das Item eingefügt.
  ;  Mit [RetMem] kann der Zeiger der neuen Daten erhalten werden.
  ;}
  Protected *Item.List_Item ;Item
  
  *Item=AllocateMemory(SizeOf(List_Item))
  If *Item
    If *List\LItem
      *Item\P=*List\LItem
      *List\LItem\N=*Item
      *List\LItem=*Item
    Else
      *List\FItem=*Item
      *List\LItem=*Item
    EndIf
    If *Mem=0
      *Item\Mem=AllocateMemory(*List\Item_MemSz)
      If *Item\Mem=#False
        ProcedureReturn #False
      EndIf
    Else
      *Item\Mem=*Mem
    EndIf
    If *RetMem : PokeL(*RetMem,*Item\Mem) : EndIf
    *List\ItemAm+1
    ProcedureReturn *Item
  EndIf
  ProcedureReturn #False
EndProcedure
Procedure.l List_DelItem(*List.List,*Item.List_Item,RetItem_Dir.b=1)
  ;List_DeleteItem(List,Item,ReturnItem_Direction=1)
  ;{
  ;  Löscht ein Item[Item] aus der Liste[List].
  ;  Entscheiden sie durch die Richtung[RetItem_Dir], welches Item
  ;  neben dem zu zertörenden Item zurückgegeben werden soll.
  ;}
  Protected *RetItem.List_Item ;ReturnItem
  
  Select RetItem_Dir
    Case 1
      *RetItem=*Item\N
    Case -1
      *RetItem=*Item\P
  EndSelect
  
  If *List\ItemAm=1
    *List\FItem=0
    *List\LItem=0
  ElseIf *Item=*List\FItem
    *Item\N\P=0
    *List\FItem=*Item\N
  ElseIf *Item=*List\LItem
    *Item\P\N=0
    *List\LItem=*Item\P
  Else
    *Item\N\P=*Item\P
    *Item\P\N=*Item\N
  EndIf
  If FreeMemory(*Item\Mem)
    If FreeMemory(*Item)=#False
      ProcedureReturn #False
    EndIf
  Else
    ProcedureReturn #False
  EndIf
  *List\ItemAm-1
  If *RetItem
    ProcedureReturn *RetItem
  Else
    ProcedureReturn #False
  EndIf
EndProcedure



;/------------------------------------------\
;| Examples                                 |
;\------------------------------------------/

;{[ Viewing of lists ]
;   Structure House
;     Street.s
;     Number.w
;     Age.l
;   EndStructure
;   
;   ;[ Defining of variables ]
;   Global *HouseList.List
;   Global *Item.List_Item
;   Global *House.House
;   
;   *HouseList=List(SizeOf(House)) ;SizeOf(House) : Size of the item data.
;   
;   ;[ Creating of items/houses ]
;   *Item=List_ItemL(*HouseList,@*House)
;   *House\Street="Bla"
;   *House\Number=4
;   *House\Age   =12
;   *Item=List_ItemL(*HouseList,@*House)
;   *House\Street="Blabla"
;   *House\Number=11
;   *House\Age   =1
;   *Item=List_ItemL(*HouseList,@*House)
;   *House\Street="Blablabla"
;   *House\Number=8
;   *House\Age   =2
;   
;   ;[ Viewing ]
;   *Item=*HouseList\FItem ;Item = the first item of 'HouseList'.
;   While *Item
;     *House=*Item\Mem ;Get item-data/memory
;     
;     Debug "---"
;     Debug *House\Street
;     Debug *House\Number
;     Debug *House\Age
;     
;     *Item=*Item\N ;Sets the item to the next item.
;   Wend
;}

Mit diesem Template ist es möglich Listen in Strukturen zu integrieren, da
eine Funktion ("List(Size)") einen Zeiger auf eine neue Liste zurückgibt.
Genauso ist es möglich Listen in Listen (TreeLists / Datenbäube) einzufügen.


Dieses Template habe ich auch in meinem Spiel "Box Wars" angewendet:
http://www.purebasic.fr/german/viewtopic.php?t=16829

So kann etwa eine Struktur für eine TreeList aussehen.

Code: Alles auswählen

IncludeFile "List.pbi"

Structure Item
  Name.s
EndStructure
Structure TreeList_Item
  Type.l
  StructureUnion
    *Item.Item ;Type = 0
    *TreeList.List ;Type = 1
  EndStructureUnion
EndStructure

Verfasst: 13.06.2008 12:52
von Josef Sniatecki
Gibt es irgendwelche Vorschläge, Kommentare oder Gutsagungen für
mich? :wink:

Verfasst: 13.06.2008 13:37
von Kiffi
@Josef: Wenn Du ein praktisches Beispiel für mich hättest, dann würde ich
auch verstehen, worum es geht ;-)

Grüße ... Kiffi

Beispiel

Verfasst: 14.06.2008 12:52
von Josef Sniatecki
Hier ist ein Beispiel:

Code: Alles auswählen

IncludeFile "List.pbi" ;Kann auch anders sein.

Structure User
  Name.s
  Comment.s
EndStructure

Global *UserList.List=List(SizeOf(User))
Global *UserList_Item.List_Item
Global *User.User



Repeat
  Select LCase(InputRequester("User manager","Input a comand:","")
    Case "add"
      List_ItemL(*UserList,@*User)
      ;Nun wird ein neuer User am Ende der User-Liste
      ;eingefügt. Der Pointer "*User" zeigt nun auf die Daten
      ;vom neu eingefügten Item.
      *User\Name=InputRequester("User","Input a new user name:","")
      *User\Comment=InputRequester("User","Input a comment:","")
    Case "find"
      Name.s=LCase(InputRequester("Find","Enter the name:",""))
      *UserList_Item=*UserList\FItem
      ;Setzt "*UserList_Item" auf das erste Item der User-Liste.
      While *UserList_Item ;Solange "*UserList_Item" auf ein Item zeigt.
        *User=*UserList_Item\Mem
        ;Nun zeigt "*User" auf die Daten vom aktuellen
        ;Item ("*UserList_Item")
        If LCase(*User\Name)=Name ;Name wurde gefunden.
          MessageRequester(*User\Name,*User\Comment)
          Break
        ElseIf *UserList_Item=*UserList\LItem
          ;Wenn wir schon beim letzten Item sind.
          MessageRequester("Error",Name+" is not in the list.")
        EndIf
        *UserList_Item=*UserList_Item\N
        ;Setzt "*UserList_Item" auf das nächste Item.
      Wend
    Case "delete"
      Name.s=LCase("Delete","Enter the name:","")
      *UserList_Item=*UserList\FItem
      While *UserList_Item
        *User=*UserList_Item\Mem
        If LCase(*User\Name)=Name
          ;Nun wird der User/das Item aus der Liste
          ;gelöscht.
          List_DelItem(*UserList,*UserList_Item)
        ElseIf *UserList_Item=*UserList\LItem
          MessageRequester("Error",Name+" is not in the list.")
        EndIf
        *UserList_Item=*UserList_Item\N
      Wend
    Case "show"
      ;Zeigt alle Users an.
      *UserList_Item=*UserList\FItem
      While *UserList_Item
        *User=*UserList_Item\Mem
        Debug *User\Name
        *UserList_Item=*UserList_Item\N
      Wend
    Case "quit"
      End
    Default
      MessageRequester("Error","This is an invaild comand.")
  EndSelect
ForEver

CleList(*UserList)
;Löscht alle Elemente der User-Liste.
DelList(*UserList)
;Löscht die Liste.

;Man kann auch nur "DelList" ohne "CleList" verwenden.
Durch diesen Code kann man eine Liste von Benutzerdaten
verwalten.

Re: Beispiel

Verfasst: 14.06.2008 13:07
von Kiffi
Josef Sniatecki hat geschrieben:Hier ist ein Beispiel:
überzeugt mich nicht ;-)

Kann man auch ganz normal mit LinkedLists machen:

Code: Alles auswählen

Structure User
  Name.s
  Comment.s
EndStructure

NewList UserList.User()

Repeat
  Select LCase(InputRequester("User manager","Input a comand:",""))
    Case "add"
      AddElement(UserList())
      UserList()\Name=InputRequester("User","Input a new user name:","")
      UserList()\Comment=InputRequester("User","Input a comment:","")
    Case "find"
      Name.s=LCase(InputRequester("Find","Enter the name:",""))
      Found = #False
      ForEach UserList()
        If LCase(UserList()\Name)=Name ;Name wurde gefunden.
          MessageRequester(UserList()\Name,UserList()\Comment)
          Found = #True
          Break
        EndIf
      Next  
      If Not Found
        MessageRequester("Error", Name + " is not in the list.")
      EndIf
    Case "delete"
      Name.s=LCase(InputRequester("Delete","Enter the name:",""))
      Found = #False
      ForEach UserList()
        If LCase(UserList()\Name)=Name
          DeleteElement(UserList())
          Found = #True
          Break
        EndIf
      Next
      If Not Found
        MessageRequester("Error",Name+" is not in the list.")
      EndIf
    Case "show"
      ;Zeigt alle Users an.
      ForEach UserList()
        Debug UserList()\Name
      Next
    Case "quit"
      End
    Default
      MessageRequester("Error","This is an invaild comand.")
  EndSelect
ForEver

ClearList(UserList())
Was waren nun noch mal die Vorteile Deines Codes?

Grüße ... Kiffi

Verfasst: 14.06.2008 13:10
von STARGÅTE
das mein sein auch in Listen selber verwenden kann, wie das andere hier im Forum auch schon geprogt haben

Vorteile

Verfasst: 14.06.2008 13:13
von Josef Sniatecki
Man kann z.B. Listen als Parameter für Funktionen nutzen:

Code: Alles auswählen

Procedure.l DebugListLongs(*List.List)
  Protected *Item.List_Item
  Protected *Long.Long
  
  *Item=*List\FItem
  While *Item
    *Long=*Item\Mem
    Debug *Long
    *Item=*Item\N
  Wend
EndProcedure

Global *MyList.List=List(SizeOf(Long))
Global *MyLong.Long

List_ItemL(*MyList,@*MyLong)
*MyLong\L=10
List_ItemL(*MyList,@*MyLong)
*MyLong\L=20
List_ItemL(*MyList,@*MyLong)
*MyLong\L=30
List_ItemL(*MyList,@*MyLong)
*MyLong\L=40
DebugListLongs(*MyList)

Verfasst: 14.06.2008 13:19
von Kiffi
STARGÅTE hat geschrieben:das mein sein auch in Listen selber verwenden kann,
pardon? Verstehe ich nicht.
Josef Sniatecki hat geschrieben:Man kann z.B. Listen als Parameter für Funktionen nutzen
LinkedLists kann man auch als Parameter übergeben.

Grüße ... Kiffi

Re: Vorteile

Verfasst: 14.06.2008 13:21
von ts-soft
Josef Sniatecki hat geschrieben:Man kann z.B. Listen als Parameter für Funktionen nutzen:
Wurde das nicht mit PB 4 eingeführt? :wink:

Verfasst: 14.06.2008 13:23
von Josef Sniatecki
Ich weiß nur, dass man Zeiger auf Elemente als Parameter
geben kann.

Wenn man aber doch LinkedLists als Parameter übergeben kann, dann
könntet ihr ja auch ein Beispielcode posten.
Alle Zeiten sind UTC+02:00
Seite 1 von 2

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de