  | 
					
						Das deutsche QBasic- und FreeBASIC-Forum Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!   
						
						
					 | 
				 
			 
			 
	
		| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen   | 
	 
	
	
		| Autor | 
		Nachricht | 
	 
	
		OneCypher
 
 
  Anmeldungsdatum: 23.09.2007 Beiträge: 802
 
  | 
		
			
				 Verfasst am: 09.09.2010, 12:29    Titel: [LIN & WIN]yet another Collection | 
				     | 
			 
			
				
  | 
			 
			
				Hallo zusammen,
 
 
Ich weiss nicht obs jemanden helfen kann, aber hier ein kurzes Makro, mit dem man Kollektionen von BELIEBIGEN Datentypen erstellen kann:
 
Collection.bi
 
 	  | Code: | 	 		  
 
#macro warning(text,lineno)
 
   #print __file__(lineno) warning: text
 
#endmacro
 
 
#macro InitCollection(UserType)
 
        Type UserType##_ItemContainer
 
            NextItem as UserType##_ItemContainer ptr
 
            ItemPtr as UserType ptr
 
        end type
 
        
 
        type UserType##_Collection
 
            public:
 
                declare sub Clear()
 
                declare function Add(Item as UserType ptr) as UserType ptr
 
                declare function Items(i as integer) as UserType ptr
 
                declare function Count as integer
 
                declare function remove(i as integer) as UserType ptr
 
                declare sub Clear overload(i as integer)
 
                declare destructor()
 
            private:
 
                PrivateCounter as integer
 
                FirstItem as UserType##_ItemContainer ptr
 
                LastItem as UserType##_ItemContainer ptr
 
        end type
 
        
 
#endmacro
 
 
#macro EndCollection(UserType)
 
        function UserType##_Collection.Add(Item as UserType ptr) as UserType ptr
 
            If FirstItem = 0 then
 
                FirstItem = new UserType##_ItemContainer
 
                FirstItem->ItemPtr = Item
 
                LastItem = FirstItem
 
            else
 
                LastItem->NextItem = new UserType##_ItemContainer
 
                LastItem = LastItem->NextItem
 
                LastItem->ItemPtr = Item
 
            end if
 
            PrivateCounter += 1
 
            return Item
 
        end function
 
        
 
        function UserType##_Collection.items(i as integer) as UserType ptr
 
            dim Counter as integer = 0
 
            Dim CountItem as UserType##_ItemContainer ptr = FirstItem
 
            while CountItem <> 0
 
                Counter = Counter +1
 
                if Counter = i then return CountItem->ItemPtr
 
                CountItem = CountItem->NextItem
 
            wend
 
            return 0
 
        end function
 
        
 
        function UserType##_Collection.remove(i as integer) as UserType ptr
 
            dim Counter as integer = 0
 
            Dim RemovedItem as UserType ptr
 
            Dim RemovedContainer as UserType##_ItemContainer ptr
 
            Dim PrevContainer as UserType##_ItemContainer ptr
 
            Dim CountItem as UserType##_ItemContainer ptr = FirstItem
 
            while CountItem <> 0
 
                Counter = Counter +1
 
                if Counter = i then
 
                    RemovedItem = CountItem->ItemPtr
 
                    RemovedContainer = CountItem
 
                    If FirstItem = CountItem then
 
                        FirstItem = FirstItem->NextItem
 
                    end if
 
                    If LastItem = CountItem then
 
                        LastItem = PrevContainer
 
                    end if
 
                    if PrevContainer <> 0 then 
 
                        PrevContainer->NextItem = RemovedContainer->NextItem
 
                    end if
 
                    delete RemovedContainer
 
                    PrivateCounter -= 1
 
                    return RemovedItem
 
                end if
 
                PrevContainer = CountItem
 
                CountItem = CountItem->NextItem
 
            wend
 
            return 0
 
        end function
 
        
 
        function UserType##_Collection.Count() as integer
 
            'dim i as integer = 0
 
            'Dim CountItem as UserType##_ItemContainer ptr = FirstItem
 
            'while CountItem <> 0
 
            '    i = i +1
 
            '    CountItem = CountItem->NextItem
 
            'wend
 
            return PrivateCounter
 
        end function
 
        
 
        sub UserType##_Collection.Clear()
 
            Dim C as integer' = This.Count
 
            Dim Removed as UserType ptr
 
            if c > 0 then
 
                for i as integer = C to 1 step -1
 
                    removed = remove(i)
 
                    if removed <> 0 then delete removed
 
                next
 
            end if
 
        end sub
 
        
 
        sub UserType##_Collection.Clear overload(i as integer)
 
            Dim Removed as UserType ptr
 
            removed = remove(i)
 
            if removed <> 0 then delete removed
 
        end sub
 
        destructor UserType##_Collection()
 
        dim a as UserType ptr
 
            Dim C as integer = This.Count
 
            if c > 0 then
 
                for i as integer = C to 1 step -1
 
                    remove(i)
 
                next
 
           end if
 
        end destructor
 
#endmacro
 
 
#macro MakeCollectable(UserType)
 
    #ifndef UserType##_ItemContainer
 
        InitCollection(UserType)
 
        EndCollection(UserType)
 
    #else
 
        warning( : UserType collection already defined!, __line__)
 
    #endif
 
#endmacro
 
 
#define CollectionOf(UserType) UserType##_Collection
 
 
type StringType
 
    TmpString as string
 
    declare constructor(s as string)
 
end type
 
 
constructor StringType(s as string)
 
    TmpString = s
 
end constructor
 
 
function NewString(byref s as string) as string ptr
 
    return cast(string ptr, new StringType(s))
 
end function
 
 
 
 | 	  
 
 
Und hier ein Beispiel:
 
 
 	  | Code: | 	 		  
 
#include once "Collection.bi"
 
MakeCollectable(String)
 
 
Dim Liste as CollectionOf(String)
 
 
dim c as integer
 
 
Input "Wieviele?", c
 
 
for i as integer = 1 to c
 
    If rnd > 0.5 then
 
        Liste.add NewString("Bla")
 
    else
 
        Liste.add NewString("Blub")
 
    end if
 
next
 
 
for i as integer = 1 to Liste.Count
 
    print *Liste.items(i)
 
next
 
 
sleep
 
 | 	  
 
 
oder
 
 
 	  | Code: | 	 		  
 
#include once "Collection.bi"
 
Type TestType
 
    x as integer = int(rnd* 100)
 
    y as integer = int(rnd*100)
 
    Name as string
 
end type
 
 
MakeCollectable(TestType)
 
 
Dim Liste as CollectionOf(TestType)
 
 
for i as integer = 1 to (int(rnd * 10) + 10)
 
    Liste.add(New TestType)->Name = "Hallo " & i
 
next
 
 
for i as integer = 1 to Liste.Count
 
    print "X=" & Liste.items(i)->x & " Y=" & Liste.items(i)->y & " Name=" & Liste.items(i)->Name
 
next
 
 
sleep
 
 | 	  
 
 
Wenn es jemanden nützt oder jemand verbesserungsvorschläge hat, einfach bescheid geben  
 
(Aber wahrscheinlich gibts sowas auch schon zig fach von anderen FB-Programmierern programmiert)
  Zuletzt bearbeitet von OneCypher am 14.09.2010, 13:20, insgesamt einmal bearbeitet | 
			 
		  | 
	 
	
		| Nach oben | 
		 | 
	 
	
		  | 
	 
	
		Stueber
 
 
  Anmeldungsdatum: 07.07.2008 Beiträge: 202
 
  | 
		
			
				 Verfasst am: 09.09.2010, 18:57    Titel:  | 
				     | 
			 
			
				
  | 
			 
			
				Sieht auf den ersten Blick ganz ordentlich aus, hab aber trotzdem ein paar Tipps und Vorschläge  .
 
 
1.: Deine Count() Funktion zählt bei jedem Aufruf durch. Bei vielen Items in der Liste wird das unglaublich langsam. Du solltest eine Variable im UDT anlegen die jedesmal um 1 erhöht oder verringert wird wenn ein Item hinzugefügt oder entfernt wird.
 
 
2.: Du musst bei einer Liste den Zuweisungsoperator überladen, da das Programm sonst abstützt wenn die Liste kopiert wird (z.B. mit "=")
 
 
3.: Es fehlt ein Destruktor. Wird die Liste von Benutzer angelegt und mit delete gelöscht sollte clear() aufgerufen werden da sonst alle Items im Speicher verbleiben.
 
 
4.: Das Anhängen ans Ende hast du gut gemacht, aber das Einfügen am Anfang der Liste oder irgendwo in die Liste ist nicht möglich. Das sind absolute must-have Features für eine Liste.
 
 
5.: Es fehlen noch viele Funktionen die den Umgang mit der Liste leichter machen, z.B. contain() oder mid().
 
 
Mehr hab ich direkt jetzt nicht gesehen, ich hoffe es hilft dir.   Vielleicht kann ich später mal ein Beispiel einer Liste hochladen die etwas anders funktioniert als deine. Wenn es dich interessiert: http://www.freebasic-portal.de/porticula/liste-bugfix2-1116.html. Die Liste hab ich vor einiger Zeit mal geschrieben, ist aber wenn ich sie mir heute anschaue auch nicht gerade perfekt. | 
			 
		  | 
	 
	
		| Nach oben | 
		 | 
	 
	
		  | 
	 
	
		OneCypher
 
 
  Anmeldungsdatum: 23.09.2007 Beiträge: 802
 
  | 
		
			
				 Verfasst am: 10.09.2010, 08:25    Titel:  | 
				     | 
			 
			
				
  | 
			 
			
				@Stueber: Einige gute Vorschläge, danke  
 
 
Zu 1. Ja, kann ich so machen, hatte ich auch schon drüber nachgedacht...
 
 
Zu 2.  Warum will man eine Liste kopieren? Das würde Probleme im Konzept mitsich ziehen... 
 
 
Zu 3. Die Items sollen im Speicher bleiben, lediglich die Liste selbst bzw deren Container sollen im Destructor gelöscht werden.
 
(Mein Gedanke dahinter: Reisst man das Inhaltsverzeichniss eines Buches herraus, existieren die seiten ja trotzdem weiter)
 
 
Zu 4. Das würde den Code ziemlich aufblähen :-/ (näheres in 5.)
 
 
Zu 5. Es gäbe zig Funktionen die man einbauen könnte. Ich wollte aber eine möglichst schlanke, übersichtliche Kollektion. Nur die absolut lebens-notwendigsten Funktionen wollte ich implementieren.
 
(Ich wollte erst sogar auf Clear() verzichten)
 
 
Werd mir mal deine Liste im detail anschauen, vielleicht "klau" ich ja noch was   | 
			 
		  | 
	 
	
		| Nach oben | 
		 | 
	 
	
		  | 
	 
	
		OneCypher
 
 
  Anmeldungsdatum: 23.09.2007 Beiträge: 802
 
  | 
		
			
				 Verfasst am: 14.09.2010, 13:22    Titel:  | 
				     | 
			 
			
				
  | 
			 
			
				Habs mal aktualisiert   ..
 
 
Übrigens, Microsofts Datentyp Collection hat 4 funktionen:
 
Add, Count, Item und Remove
 
 
Und genau so einfach würde ich es generell gerne halten. Ok und Clear muss ich sagen vermisse ich sogar bei der MS-Version... | 
			 
		  | 
	 
	
		| Nach oben | 
		 | 
	 
	
		  | 
	 
	
		 | 
	 
 
  
	 
	    
	   | 
	
Du kannst keine Beiträge in dieses Forum schreiben. Du kannst auf Beiträge in diesem Forum nicht antworten. Du kannst deine Beiträge in diesem Forum nicht bearbeiten. Du kannst deine Beiträge in diesem Forum nicht löschen. Du kannst an Umfragen in diesem Forum nicht mitmachen.
  | 
   
 
     |