PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

PB LinkedList holding different elements

https://www.purebasic.fr/english/viewtopic.php?t=24688

Page 1 of 1

PB LinkedList holding different elements

Posted: Sun Nov 19, 2006 10:28 pm
by Guimauve
Hello everyone

This is an exemple to show how the Standard PB Linked list can be stripped to hold very differents structure. It's a basic Polymorphysm exemple.

If this crasy code can be usefull for someone...

Regards
Guimauve

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : PB LinkedList holding different elements
; File : Adapter.pb
; File Version : 0.0.0
; Programmation : EXPERIMENTAL CODE
; Programmed by : Guimauve
; Date : 19-11-2006
; Last Update : 19-11-2006
; Coded for PureBasic V4.00
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; AUTOMATICALLY GENERATED CODE, DO NOT MODIFY
; UNLESS YOU REALLY, REALLY, REALLY MEAN IT !!
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Enumeration 1
   
   #DataType_LocalTime
   #DataType_POINT
   #DataType_POINTFX
   
EndEnumeration

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Structure declaration <<<<<

Structure Adapter
   
   DataType.b
   ElementPtr.l
   
EndStructure

; <<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The accessors <<<<<

Macro AdapterDataType(AdapterA)
   
   AdapterA\DataType
   
EndMacro

Macro AdapterElementPtr(AdapterA)
   
   AdapterA\ElementPtr
   
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Complete Reset operator <<<<<

Macro ResetAdapter(AdapterA)
   
   RtlZeroMemory_(AdapterA, SizeOf(Adapter))
   
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Code generated in : 00.001 seconds <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Structure declaration <<<<<

Structure LocalTime
   
   wYear.w
   wMonth.w
   wDayOfWeek.w
   wDay.w
   wHour.w
   wMinute.w
   wSecond.w
   wMilliseconds.w
   
EndStructure

; <<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The mutators <<<<<

Macro SetLocalTime(LocalTimeA)
   
   GetLocalTime_(LocalTimeA)
   
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The accessors <<<<<

Macro LocalTimewYear(LocalTimeA)
   
   LocalTimeA\wYear
   
EndMacro

Macro LocalTimewMonth(LocalTimeA)
   
   LocalTimeA\wMonth
   
EndMacro

Macro LocalTimewDayOfWeek(LocalTimeA)
   
   LocalTimeA\wDayOfWeek
   
EndMacro

Macro LocalTimewDay(LocalTimeA)
   
   LocalTimeA\wDay
   
EndMacro

Macro LocalTimewHour(LocalTimeA)
   
   LocalTimeA\wHour
   
EndMacro

Macro LocalTimewMinute(LocalTimeA)
   
   LocalTimeA\wMinute
   
EndMacro

Macro LocalTimewSecond(LocalTimeA)
   
   LocalTimeA\wSecond
   
EndMacro

Macro LocalTimewMilliseconds(LocalTimeA)
   
   LocalTimeA\wMilliseconds
   
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Complete Reset operator <<<<<

Macro ResetLocalTime(LocalTimeA)
   
   LocalTimewYear(LocalTimeA) = 0
   LocalTimewMonth(LocalTimeA) = 0
   LocalTimewDayOfWeek(LocalTimeA) = 0
   LocalTimewDay(LocalTimeA) = 0
   LocalTimewHour(LocalTimeA) = 0
   LocalTimewMinute(LocalTimeA) = 0
   LocalTimewSecond(LocalTimeA) = 0
   LocalTimewMilliseconds(LocalTimeA) = 0
   
   ; RtlZeroMemory_(LocalTimeA, SizeOf(LocalTime))
   
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Debugging macro <<<<<

Procedure DebugLocalTime(*LocalTimeA.LocalTime)
   
   Debug "-----------------------------------------------------"
   Debug "Structure : LocalTime"
   Debug LocalTimewYear(*LocalTimeA)
   Debug LocalTimewMonth(*LocalTimeA)
   Debug LocalTimewDayOfWeek(*LocalTimeA)
   Debug LocalTimewDay(*LocalTimeA)
   Debug LocalTimewHour(*LocalTimeA)
   Debug LocalTimewMinute(*LocalTimeA)
   Debug LocalTimewSecond(*LocalTimeA)
   Debug LocalTimewMilliseconds(*LocalTimeA)
   Debug "-----------------------------------------------------"

EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Code generated in : 00.016 seconds <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Constructor <<<<<

Procedure CreateNewLocalTime()
   
   *NewLocalTime.LocalTime = AllocateMemory(SizeOf(LocalTime))
   
   If *NewLocalTime = #Null
      MessageRequester("Fatal Error", "CreateNewLocalTime() - Impossible to Allocate Memory !")
   EndIf
   
   ProcedureReturn *NewLocalTime
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Destructor <<<<<

Procedure.b DestroyLocalTime(*LocalTime.LocalTime)
   
   If *LocalTime <> #Null 
      
      ResetLocalTime(*LocalTime)
      FreeMemory(*LocalTime)
      DestroySuccess.b = #True
      
   EndIf
   
   ProcedureReturn DestroySuccess
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Code generated in : 00.032 seconds <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure AttachLocalTime(*AdapterA.Adapter, *Element.LocalTime)
   
   *New.LocalTime = CreateNewLocalTime()
   If *New <> 0
      AdapterDataType(*AdapterA) = #DataType_LocalTime
      CopyMemory(*Element, *New, SizeOf(LocalTime))
      AdapterElementPtr(*AdapterA) = *New
   EndIf 
   
EndProcedure

Procedure ExtractLocaltime(*AdapterA.Adapter)
   
   ProcedureReturn AdapterElementPtr(*AdapterA)
   
EndProcedure

Procedure DirectAttachLocalTime(*AdapterA.Adapter)
   
   *New.LocalTime = CreateNewLocalTime()
   If *New <> 0
      AdapterDataType(*AdapterA) = #DataType_LocalTime
      SetLocalTime(*New)
      AdapterElementPtr(*AdapterA) = *New
   EndIf 
   
EndProcedure

Procedure DetachLocalTime(*AdapterA.Adapter)
   
   DestroyLocalTime(AdapterElementPtr(*AdapterA))
   ResetAdapter(*AdapterA)
   
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< End of Adapter-LocalTime Interface <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The mutators <<<<<

Macro SetPOINTx(PointA, P_x)
   
   PointA\x = P_x
   
EndMacro

Macro SetPOINTy(PointA, P_y)
   
   PointA\y = P_y
   
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The observators <<<<<

Macro GetPOINTx(PointA)
   
   PointA\x
   
EndMacro

Macro GetPOINTy(PointA)
   
   PointA\y
   
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Complete Reset operator <<<<<

Macro ResetPOINT(PointA)
   
   SetPOINTx(PointA, 0)
   SetPOINTy(PointA, 0)

EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Debugging macro <<<<<

Procedure DebugPOINT(*PointA.POINT)
   
   Debug "-----------------------------------------------------"
   Debug "Structure : POINT"
   Debug "(x,y) (" + Str(GetPOINTx(*PointA)) + ", " + Str(GetPOINTy(*PointA)) + ")"
   Debug "-----------------------------------------------------"
   
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Constructor <<<<<

Procedure CreateNewPoint()
   
   *New.POINT = AllocateMemory(SizeOf(POINT))
   
   If *New = #Null
      MessageRequester("Fatal Error", "CreateNewPoint() - Impossible to Allocate Memory !")
   EndIf
   
   ProcedureReturn *New
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Destructor <<<<<

Procedure.b DestroyPoint(*PointA.POINT)
   
   If *LocalTime <> #Null 
      
      ResetPOINT(*PointA)
      FreeMemory(*PointA)
      DestroySuccess.b = #True
      
   EndIf
   
   ProcedureReturn DestroySuccess
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Code generated in : 00.016 seconds <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure AttachPoint(*AdapterA.Adapter, *Element.POINT)
   
   *New.POINT = CreateNewPoint()
   If *New <> 0
      AdapterDataType(*AdapterA) = #DataType_POINT
      CopyMemory(*Element, *New, SizeOf(POINT))
      AdapterElementPtr(*AdapterA) = *New
   EndIf 
   
EndProcedure

Procedure ExtractPoint(*AdapterA.Adapter)
   
   ProcedureReturn AdapterElementPtr(*AdapterA)
   
EndProcedure

Procedure DirectAttachPoint(*AdapterA.Adapter, P_x.l, P_y.l)
   
   *New.POINT = CreateNewPoint()
   If *New <> 0
      AdapterDataType(*AdapterA) = #DataType_POINT
      SetPOINTx(*New, P_x)
      SetPOINTy(*New, P_y)
      AdapterElementPtr(*AdapterA) = *New
   EndIf 
   
EndProcedure

Procedure DetachPoint(*AdapterA.Adapter)
   
   DestroyPoint(AdapterElementPtr(*AdapterA))
   ResetAdapter(*AdapterA)
   
EndProcedure


; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< End of Adapter-POINT Interface <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The mutators <<<<<

Macro SetPOINTFXx(PointA, P_x)
   
   PointA\x = P_x
   
EndMacro

Macro SetPOINTFXy(PointA, P_y)
   
   PointA\y = P_y
   
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The observators <<<<<

Macro GetPOINTFXx(PointA)
   
   PointA\x
   
EndMacro

Macro GetPOINTFXy(PointA)
   
   PointA\y
   
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Complete Reset operator <<<<<

Macro ResetPOINTFX(PointA)
   
   SetPOINTFXx(PointA, 0)
   SetPOINTFXy(PointA, 0)
   
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Debugging macro <<<<<

Procedure DebugPOINTFX(*PointA.POINTFX)
   
   Debug "-----------------------------------------------------"
   Debug "Structure : POINTFX"
   Debug "(x,y) (" + Str(GetPOINTFXx(*PointA)) + ", " + Str(GetPOINTFXy(*PointA)) + ")"
   Debug "-----------------------------------------------------"
   
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Constructor <<<<<

Procedure CreateNewPointFX()
   
   *New.POINT = AllocateMemory(SizeOf(POINT))
   
   If *New = #Null
      MessageRequester("Fatal Error", "CreateNewPoint() - Impossible to Allocate Memory !")
   EndIf
   
   ProcedureReturn *New
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Destructor <<<<<

Procedure.b DestroyPointFX(*PointA.POINTFX)
   
   If *LocalTime <> #Null 
      
      ResetPOINTFX(*PointA)
      FreeMemory(*PointA)
      DestroySuccess.b = #True
      
   EndIf
   
   ProcedureReturn DestroySuccess
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Code generated in : 00.016 seconds <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure AttachpointFX(*AdapterA.Adapter, *Element.POINTFX)
   
   *New.POINTFX = CreateNewPointFX()
   If *New <> 0
      AdapterDataType(*AdapterA) = #DataType_POINTFX
      CopyMemory(*Element, *New, SizeOf(POINT))
      AdapterElementPtr(*AdapterA) = *New
   EndIf 
   
EndProcedure

Procedure ExtractpointFX(*AdapterA.Adapter)
   
   ProcedureReturn AdapterElementPtr(*AdapterA)
   
EndProcedure

Procedure DirectAttachpointFX(*AdapterA.Adapter, P_x.l, P_y.l)
   
   *New.POINTFX = CreateNewPointFX()
   If *New <> 0
      AdapterDataType(*AdapterA) = #DataType_POINTFX
      SetPOINTFXx(*New, P_x)
      SetPOINTFXy(*New, P_y)
      AdapterElementPtr(*AdapterA) = *New
   EndIf 
   
EndProcedure

Procedure DetachpointFX(*AdapterA.Adapter)
   
   DestroyPointFX(AdapterElementPtr(*AdapterA))
   ResetAdapter(*AdapterA)
   
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< End of Adapter-POINTFX Interface <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

;/ <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
;/ <<<<< !!! WARNING - YOU ARE NOW IN A TESTING ZONE - WARNING !!! <<<<<
;/ <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Macro RandomMinMax(min, max)
    
   (max - Random(max - min))
    
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The new linked list of Adapter <<<<<

NewList MyList.Adapter()

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< OK it's time to add element to the list <<<<<

Debug "To attach elements to the list need 6-7 seconds, be patient ..."
Debug "It's for Localtime, we want to see some differences."
Debug "-----------------------------------------------------"

While CountList(MyList()) < 12
   
   Delay(500)
   
   AddElement(MyList())
   
   DataType = RandomMinMax(#DataType_LocalTime, #DataType_POINTFX)
   
   Select DataType
      
      Case #DataType_LocalTime
         
         If AttachDirectLocalTime = 0
            AttachDirectLocalTime = 1
            SetLocalTime(LooseLocalTime.LocalTime)
            AttachLocalTime(MyList(), LooseLocalTime)
         Else 
            
            DirectAttachLocalTime(MyList())
         EndIf
         
      Case #DataType_POINT
         
         If AttachDirectPOINT = 0
            AttachDirectPOINT = 1
            SetPOINTx(LoosePOINT.POINT, 50)
            SetPOINTy(LoosePOINT.POINT, 75)
            AttachPoint(MyList(), LoosePOINT)
         Else 
            DirectAttachPoint(MyList(), Coord_X, Coord_Y)
            Coord_X + 25
            Coord_Y + 33
         EndIf
         
      Case #DataType_POINTFX
         
         If AttachDirectPOINTfx = 0
            AttachDirectPOINTfx = 1
            SetPOINTFXx(LoosePOINTfx.POINTFX, 50)
            SetPOINTFXy(LoosePOINTfx.POINTFX, 75)
            AttachpointFX(MyList(), LoosePOINTfx)
         Else 
            DirectAttachpointFX(MyList(), Coord_X_FX, Coord_Y_FX)
            Coord_X_FX + 44
            Coord_Y_FX + 55
         EndIf
         
   EndSelect
   
Wend

Debug "Ok we have some element to the list."
Debug " It's time to see the information."
Debug "-----------------------------------------------------"

ForEach MyList()
   
   Select AdapterDataType(MyList())
      
      Case #DataType_LocalTime
         DebugLocalTime(AdapterElementPtr(MyList()))
         
      Case #DataType_POINT
         DebugPOINT(AdapterElementPtr(MyList()))
         
      Case #DataType_POINTFX
         DebugPOINTFX(AdapterElementPtr(MyList()))
         
   EndSelect
   
Next

Debug "Ok we Detach everyting ..."
Debug "-----------------------------------------------------"

ForEach MyList()
   
   Select AdapterDataType(MyList())
      
      Case #DataType_LocalTime
         DetachLocalTime(MyList())

      Case #DataType_POINT
         DetachPoint(MyList())

      Case #DataType_POINTFX
         DetachpointFX(MyList())
   
   EndSelect
   
Next

Debug "Re debug the list for information"
Debug "-----------------------------------------------------"

ForEach MyList()
   
   Select AdapterDataType(MyList())
      
      Case #DataType_LocalTime
         DebugLocalTime(AdapterElementPtr(MyList()))
         
      Case #DataType_POINT
         DebugPOINT(AdapterElementPtr(MyList()))
         
      Case #DataType_POINTFX
         DebugPOINTFX(AdapterElementPtr(MyList()))
         
      Default 
         Debug "MyList() Index " + Str(ListIndex(MyList())) + " is empty !"
         
   EndSelect
   
Next

Debug "This is the END"
Debug "-----------------------------------------------------"

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

Posted: Tue Nov 21, 2006 11:13 am
by kinglestat
I get an error "RandomMinMax" is not as function or macro when trying it out
the idea is interesting....

cheers

KingLestat

Posted: Tue Nov 21, 2006 12:21 pm
by Fangbeast
kinglestat wrote:I get an error "RandomMinMax" is not as function or macro when trying it out
the idea is interesting....

cheers

KingLestat
You have to uncomment this macro in his source

; Macro RandomMinMax(min, max)
;
; (max - Random(max - min))
;
; EndMacro

Posted: Wed Nov 22, 2006 3:47 am
by Guimauve
Sorry about that...

I forget to uncomment this macro when I have posted this code.

The exemple should be ok now.

Regards
Guimauve
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited