TypeOf- ideas

[ReneMiner]

I urge for some way to determine TypeOf a variable and to conserve it somehow..so it can be used as an Alias for variable-types.
I did different attempts using thinBasic_VariableGetInfoPtr but somehow seems to return randomized different values in MainType and also does not work on Udt-Subsets because can not pass "VarPtr(myVar.X)" and expect valid results from it. TypeOf should work on all primitives - for UDTs it probably would just return %Type_UDT...

Currently I have a function which could use TypeOf-Results - in this case just some Peek-Replacement so I can set arbitrary type to Peek at ptr.



Uses "console"

Begin Const
%Type_Unknown = 0
%Type_Byte
%Type_Integer
%Type_Boolean
%Type_Word
%Type_DWord
%Type_Long
%Type_Quad
%Type_Single
%Type_Double
%Type_Currency
%Type_Ext
%Type_Number = 20
%Type_AsciiZ = 25
%Type_String = 30
%Type_GUID = 40
%Type_Variant = 50
%Type_UDT = 60
%Type_PTR = 70
%Type_Object = 80
%Type_Class = 90
End Const

String sTest = MKL$(12345)
' test Memory_Read:
PrintL Memory_Read StrPtr sTest, %Type_Long

sTest = MKD$(12.345)
PrintL Memory_Read StrPtr sTest, %Type_Double

sTest = "Test"
PrintL Memory_Read StrPtr sTest, %Type_String

PrintL $CRLF + "key to end" + $CRLF

WaitKey

' ----------------------------------------------------
' some Peek-Any-Replacement...
Function Memory_Read( ByVal mPtr As DWord, _
ByVal as_Type As Long _
) As Any

If mPtr Then
Select Case as_Type
Case %Type_Byte
Function = Peek(mPtr)
Case %Type_Integer
Function = Peek(Integer, mPtr)
Case %Type_Boolean
Function = Peek(Boolean, mPtr)
Case %Type_Word
Function = Peek(Word, mPtr)
Case %Type_DWord, %Type_PTR
Function = Peek(DWord, mPtr)
Case %Type_Long
Function = Peek(Long, mPtr)
Case %Type_Quad
Function = Peek(Quad, mPtr)
Case %Type_Single
Function = Peek(Single, mPtr)
Case %Type_Double
Function = Peek(Double, mPtr)
Case %Type_Currency
Function = Peek(Currency, mPtr)
Case %Type_Ext
Function = Peek(Ext, mPtr)
Case %Type_String
Function = Memory_Get(mPtr, Peek(DWord, mPtr-4) )

'Case Else
' not possible - maybe optional passed
' Long Size could extend this -
' but could just use Memory_Get then...

End Select

EndIf
End Function


Now the idea is to have a TypeOf-function that returns some "Replacement" or Value for


BYTE, INTEGER, WORD, DWORD, LONG, QUAD, SINGLE, DOUBLE, EXT, CURRENCY, STRING, ASCIIZ, VARIANT, GUID, (UDT)
that could be used instead of these keywords as well in Peek+Poke and also to dim as ...(except %Type_UDT of course) - even if it would mean to do it alike that:



X = Peek( VarType(myType), myPtr)
Dim Y As VarType(%Type_Long) ' where %Type_Long could be replaced by any variable
Poke( VarType(TypeOf(Z)), Varptr(Z), newValue ) ' String probably not possible here...

[ReneMiner]

OK- forget the above- some different way:


Imagine in pre-parsing before script runs the magic behind the curtains would just count types of current code in memory- starting with core: Byte = 1, Long = 2,...
thereafter count the UDTs contained within the used modules - and enumerate them. Finally count UDTs from Script. And if I write




' =====================================
Dim X As 30 ' only means "Dim X as String"
' =====================================

Type t_Type
dPtr As Dword
dType As Long
Addition As Function
End Type

Function t_Type.Addition() As Any

Local localData As Me.dType At Me.dPtr ' uses the "magic number"

Function = localData.Addition() ' call a function of current datatype...

End Function


Type t_SubType1
A As Long
B As Byte
Addition As Function
End Type

Function t_SubType1.Addition() As Long
Function = Me.A + Me.B
End Function

Type t_SubType2
X As Double
Y As Double
Addition As Function
End Type

Function t_SubType2.Addition() As Double
Function = Me.X + Me.Y
End Function

' -- - - -- - - -- - - -- - - --

Dim Data(2) As t_Type

Data(1).dPtr = Heap_AllocByStr(MKL$(123)+MKByt$(127))
Data(1).dType = TypeOf(t_SubType1) ' - give Data information about subtype to use

Data(2).dPtr = Heap_AllocByStr(MKD$(12.3)+MKD$(45.6))
Data(2).dType = TypeOf(t_SubType2)

'...

[ReneMiner]

I can't let go of it...

Today I have another idea - what if

Dim X As "String" were valid

- and TypeOf(X) would return "String" ?

[Charles Pegge]

OxygenBasic has typeof

It is a member of then "of" keyword family (sizeof spanof ...) and mostly used for diagnostics.

It can also be used to create variables, though I am not sure if this is good programming practice :)

double d
..
typeof (d) e 'type of e is now double

[ReneMiner]

But could I do this in oxygen:

Dim A As t_myUDT

X = TypeOf(A)

Dim B As X ' - B should be of Type t_myUDT now...

- so "to conserve" the type for later to create some absolute variable of the "conserved type" at some memory?
I don't know maybe X ist just a Long that holds a Type-Number - maybe it's a string that holds the types name or maybe it's a pointer to the sturcture of the type...

[Charles Pegge]

No, Oxygen would treat X as a string "myUDT".

O2 is statically typed: all types have to be resolved at compile-time.

[kryton9]

How does c++ do it with templates? I have been trying to figure out how to implement data containers of any type: int, float, class, udt... in oxygen.


http://en.wikipedia.org/wiki/Template_(C%2B%2B)

[ReneMiner]

When I check out the linked wiki-page above then I'm so happy that we are dealing with flexible, readable basic here and not with brainpain C++.

The type exists at start - and the variable to create is just a virtual, mostly a local one - never really allocating space, but just to interpret already stored data the right way...

Might it be possible to allow a function (string directly would serve as well) as type-name-substitute ?

Perhaps I should change from "TypeOf" to some new expressions - both ways
- MKType$() + CVType()



Dim A As CVType("Byte") At pMyData
'...

Type t_myType1 ' arbitrary udt...
A As Long
B As Byte
C As Single
End Type

Dim foo As t_myType1

String sType = MKType$(foo)
'...sType would hold "t_myType1" now

Dim dummy As CVType( sType ) At Varptr foo



I realized Overlay already being a keyword - but does it have any functionality?

[kryton9]

Just putting this link as a reference for others interested in this sort of thing. A pretty good explanation between templates and generics.
http://msdn.microsoft.com/en-us/library/vstudio/sbh15dya.aspx

[ReneMiner]

Is there any chance that keyword "AS" could accept a type stored in a string?

[ErosOlmi]

I will put into ToDo list for the next version.
It is quite complex having such a feature all over all possible places where a type can be indicated.
I will start from DIM/LOCAL/GLOBAL

[ReneMiner]

I think as a Function-result or Parameter it would not be appropriate -


Function myFun (ByVal s As "someType") As "someType"

' neither this:
Type t_myType
X As "someOtherType"
End Type

would be ... nonsense? :D

But like this:



Function CreateSomething(Byval what as String) As Dword

Local localData as what

Function = Heap_Alloc(SizeOf(localData))

End Function

' ... in some other function:
String current_Type = "t_myType"

Local virtualDummy As current_Type At CreateSomething(current_Type)


would serve. Maybe use another keyword, such as SuchAs
:D

[ReneMiner]

ok, we have the "like" now, but still limited to simple variables - somehow you did it to do a trick with the string-content in pre-parsing ;)


I just collect some thoughts for the udts where the "like" could be very powerful and useful, especially to "privatize" data.

The usage for udts could be limited to local virtual overlays only
- because that's the reason for the idea:
to dim a LOCAL virtual overlay inside some multiple useable function at some already existing piece of memory,
the memory mostly unstructured as heap or string, stored as array or single element of some udt
-that udt and the allocated memory have to exist the moment when the function gets called already...

It would serve if a string containing the udts-name or pattern has to be passed mandatory as a parameter somehow to the function where the virtual overlay


Local foo Like theUdtIPassedInThatString At memoryptr

will be done, but to be dynamic this would need the reverse way to retrieve the types-name from some variable or its pointer into a string also i fear.

So would be fine too if some core-function would just return some in every script-execution varying long/byte/whatever/ "temporary constant for duration of this execution" -numeral that can be used to dimension the overlay later - just to save information about the desired udt somehow.



Long myType = Type_GetHandle(myUDT)

'where myUDT could be some udt-name or some variable of that udt
' - both have pros & contras
' I'd prefer to retrieve it from a variables name - or even from its pointer
...
Local foo Like myType At memoryptr
' foo.Init()

since all types of all units are known when the script starts running...

I know, it's complicated. Else I would have found a basic solution already :D

[ErosOlmi]

I was able to get something, not sure it is 100% what you asked but maybe on the right track.
Download again http://www.thinbasic.biz/projects/th...c_1.9.12.0.zip (http://www.thinbasic.biz/projects/thinbasic/thinBasic_1.9.12.0.zip)

Example:


Type lType
i As Integer
l As Long

Mult As Function
End Type


Function lType.Mult() As Long
Function = Me.i * Me.l
End Function


Dim MyType As lType


Function FunctionExample(ByVal p As Long) As Long
Dim x1 As Byte
Dim x2 Like "byte" '---Like [any string expression representing a basic type]
X1 = 1
x2 = 2


Dim y1 As p '--- Define [Y1] with the same type of [p] variable
y1 = 10 * p

Dim z1 As MyType '--- Define [z1] with the same type of [MyType] variable
z1.i = 10
z1.l = 100
MsgBox 0, z1.Mult

End Function


FunctionExample(1000)


MsgBox 0, "Finished"




Main rules so far:


AS can be followed by a variable name. ThinBASIC will use that variable type to declare a the new variable.
LIKE can be follower by a string expression representing the type. Only basic types can be used so far, not UDT at the moment.
You ca use those new options only when declaring a new variable. It will not work inside UDT declaration and Function parameters

[ReneMiner]

almost there :D

If AS can dim some variable from the name of another variable, would it be possible for LIKE to dim some variable from the name of another variable stored in a string? If yes, why should not be possible to do have LIKE to use the way "Dim X Like "lType"

And could it be possible to have a special "Identify ME"-function then, which will always be to find inside some type-function - mostly X.Create() -
but not necessarily the same type as the functions parenting type because could be some extended child of that type too.

such as:
String udtname = Identify Me

so in the end we could simply store the "child-Type"-information in the base-type and use the stored information to place a fitting overlay onto some chunk of data, then this chunk of data all of a sudden is able to perform own common "methods", i.e. Type-functions on data which is not stored in a global UDT-variable, so data is not accessable globally but needs to use the lowest base-types rules ("class object") to get access to that "family"...

wait a second... :read: ...what are we doing here?

[ErosOlmi]

Download again http://www.thinbasic.biz/projects/th...c_1.9.12.0.zip (http://www.thinbasic.biz/projects/thinbasic/thinBasic_1.9.12.0.zip)

Example:


Type lType
i As Integer
l As Long

Mult As Function
End Type


Function lType.Mult() As Long
Function = Me.i * Me.l
End Function


Dim MyType As lType


Function FunctionExample(ByVal p As Long) As Long
Dim x1 As Byte
Dim x2 Like "byte" '---Like [any string expression representing a basic type]
X1 = 1
x2 = 2


Dim y1 As p '--- Define [Y1] with the same type of [p] variable
y1 = 10 * p

Dim z1 As MyType '--- Define [z1] with the same type of [MyType] variable
z1.i = 10
z1.l = 100
MsgBox 0, z1.Mult


Dim kk As Byte

Dim z2 Like "MyType" '--- Define [z2] with the same type of [MyType] variable using Like followed by a string expression
z2.i = 100
z2.l = 1000
MsgBox 0, z2.Mult


Dim z3 Like "lType" '--- Define [z3] with the same type of [tType] TYPE using Like followed by a string expression
z3.i = 1000
z3.l = 10000
MsgBox 0, z3.Mult

End Function


FunctionExample(1000)


MsgBox 0, "Finished"




Main rules so far:


AS can be followed by a variable name. ThinBASIC will use that variable type to declare a the new variable.
LIKE can be follower by a string expression representing the type. Basic types, UDT variable and UDT types are supported.
You can use those new options only when declaring a new variable. It will not work inside UDT declaration and Function parameters


Now the problem will be to describe all those new features in Help File :oops:

[ReneMiner]

:yahoo:
Now it "only" needs a way to retrieve & save the correct string of type from any variable and it's perfect!



String Datatype = TypeOf(Me)
...
Local data Like DataType at myPtr

[ErosOlmi]

Rene,

why just not using something like


Local data As Me At VarPtr(Me)


It is already working but IT HAS TO BE EXECUTED from inside the Function Type to which Me refers.
Let me know.

[ReneMiner]

I tested a little... and came to the result it does not work as expected so I did not finish this to more functionality yet - has a couple of useless functions now, but shows what I was up to. Because no retrieving of type possible I just pass it as parameter on Create

The types get recognized and used correctly - but just once per script execution. Calling twice the same sub with a different type to use will always dim the type again that was dim'ed the very first time... The example is a little longer, for try out/ see what I mean just exchange the order of the Test-call at end of script



#MINVERSION 1.9.12.0.

Uses "console"

Type t_virtual_object
pData As DWord
sType As String
lSize As Long

Create As Function
Destroy As Function

End Type

Function t_virtual_object.Create(ByVal sType As String, Optional ByVal lNum As Long) As DWord

Local data Like sType

If lNum < 1 Then lNum = 1 ' = Ubound/Index

Me.pData = HEAP_Alloc(SizeOf(data) * lNum)
Me.sType = sType
Me.lSize = SizeOf(data) ' store size of one element, not to get too complicated

Return Me.pData

End Function

Function t_virtual_object.Destroy() As DWord

If HEAP_Size(Me.pData) Then HEAP_Free(Me.pData)
Me.pData = 0
Me.sType = ""

Return 0

End Function

' - - - - - - - - - - - - - - - - - - - - - - - - - -

Type t_vec3d
' some simple vector with a few functions for example
X As Double
Y As Double
Z As Double

GetProperties As Function

GetX As Function
GetY As Function
GetZ As Function

SetX As Function
SetY As Function
SetZ As Function
SetXYZ As Function
End Type

Function t_Vec3d.GetProperties() As String
Function = "t_Vec3d has X,Y and Z"
End Function
Function t_vec3d.GetX() As Double
Return Me.X
End Function
Function t_vec3d.GetY() As Double
Return Me.Y
End Function
Function t_vec3d.GetZ() As Double
Return Me.Z
End Function

Function t_vec3d.SetX(ByVal X As Double) As Double
Me.X = X
Return X
End Function
Function t_vec3d.SetY(ByVal Y As Double) As Double
Me.Y = Y
Return Y
End Function
Function t_vec3d.SetZ(ByVal Z As Double) As Double
Me.Z = Z
Return Z
End Function
Function t_vec3d.SetXYZ(ByVal X As Double, ByVal Y As Double, ByVal Z As Double) As Double
Me.X = X
Me.Y = Y
Me.Z = Z
End Function
' - - - - - - - - - - - - - - - - - - - - - - - - -

Type t_RGB
' and some color-type with functions also

R As Byte
G As Byte
B As Byte

GetProperties As Function

GetR As Function
GetG As Function
GetB As Function
GetColor As Function

SetR As Function
SetG As Function
SetB As Function
SetRGB As Function
SetColor As Function

End Type
Function t_RGB.GetProperties() As String
Function = "t_RGB has R,G and B"
End Function

Function t_RGB.GetR() As Byte
Return Me.R
End Function

Function t_RGB.GetG() As Byte
Return Me.G
End Function

Function t_RGB.GetB() As Byte
Return Me.B
End Function

Function t_RGB.GetColor() As Long
Local lColor As Long
Memory_Copy( VarPtr(Me), VarPtr(lColor), 3)
Function = lColor
End Function

Function t_RGB.SetR(ByVal R As Byte) As Byte
Me.R = R
Return R
End Function

Function t_RGB.SetG(ByVal G As Byte) As Byte
Me.G = G
Return G
End Function

Function t_RGB.SetB(ByVal B As Byte) As Byte
Me.B = B
Return B
End Function

Function t_RGB.SetColor(ByVal lColor As Long) As Long
Memory_Copy(Varptr(lColor),Varptr(Me),3)
Function = lColor
End Function
' -------------------------------------------------------------
' three different types now

' have some global "objects":

Dim Colors As t_virtual_object
Dim Vectors As t_virtual_object

Vectors.Create("t_vec3d", 12) ' space for an array of 12 vecs
Colors.Create("t_RGB", 34) ' and some space for 34 colors

' now do the rest inside some subs/functions to keep the stuff "private"
Sub Test(what As t_virtual_object)

If HEAP_Size(what.pData) < 1 Then PrintL "Error- no data!": Exit Sub

Local data(HEAP_Size(what.pData)/what.lSize) Like what.sType At what.pData

PrintL data(1).GetProperties

End Sub

Test Colors
Test Vectors

PrintL "----------------------------"
PrintL "All done, press a key to end"
WaitKey

[ReneMiner]

oops- I just saw I added a SetRGB in the Type-definition but there's no function - and no errror - even it's not an extended Type :oops:

[ErosOlmi]

oops- I just saw I added a SetRGB in the Type-definition but there's no function - and no errror - even it's not an extended Type :oops:

As I said, there is still no code that checks for errors, so at the moment mainly everything is possible.
In particular, I'm thinking to add Abstract Types and Abstract Type Functions so having function declaration and not its definition will be possible, if Abstract.

[ErosOlmi]

I tested a little... and came to the result it does not work as expected so I did not finish this to more functionality yet - has a couple of useless functions now, but shows what I was up to. Because no retrieving of type possible I just pass it as parameter on Create

The types get recognized and used correctly - but just once per script execution. Calling twice the same sub with a different type to use will always dim the type again that was dim'ed the very first time... The example is a little longer, for try out/ see what I mean just exchange the order of the Test-call at end of script


If you debug you will se that the problem is at:

Function t_virtual_object.Create(ByVal sType As String, Optional ByVal lNum As Long) As DWord Local Data Like "" & sType '<<<<<<<<<<<<<<<<<<<<<<<<<<




and at:

Sub Test(what As t_virtual_object) If HEAP_Size(what.pData) < 1 Then PrintL "Error- no data!": Exit Sub
Local data(HEAP_Size(what.pData)/what.lSize) Like "" & what.sType At what.pData '<<<<<<<<<<<<<<<<<<




Like operator interpret the data type not like a data type but like a variable of a certain type.
Add a

"" &
and it will get the string as string expression and create the real data type overlay.
I will fix asap, not today, sorry.

In any case there is a much bigger problem. ThinBASIC always try to optimize code execution. When it executes the following line the first time:

PrintL data(1).GetProperties
it stores inside internal optimization structures what is Data so the second time all the info are already there.
But here we now have the possibility that Data is many different things in all different executions.
I need to understand what to do in order not to store any info about Data without slowing down execution.

Eros

[ReneMiner]

maybe you don't need to change this if one could "delete manually" the for optimization stored data if needed only, some "clear current function-buffer" or a switch "don't create optimization-data" somewhere in the function - so it always assumes it would run for the first time or does not "remember data" on exit? Or some special use of New-Keyword here?


Local New data Like "some udt"

[ErosOlmi]

Yes, something similar.
Maybe I've already found a solution: I've added a special flag in internal variables that is ON when variable has been declared using the LIKE operator.
In this case no code optimization will take place for that specific variable.

Optimization is really "visible" when inside big loops. Mainly it stores some info instead of continuously reading from internal Hash Tables.

Maybe I will be able to release a new version by this evening.

[ErosOlmi]

Download again http://www.thinbasic.biz/projects/th...c_1.9.12.0.zip (http://www.thinbasic.biz/projects/thinbasic/thinBasic_1.9.12.0.zip)

I think I've fixed the main issues.

[ReneMiner]

I fear, just to check for the "LIKE" in dim-statement won't serve. Think of

Dim data As Me

[ErosOlmi]

Rene,

why just not using something like


Local data As Me At VarPtr(Me)


It is already working but IT HAS TO BE EXECUTED from inside the Function Type to which Me refers.
Let me know.

Exactly but only when executed from inside a Type Function

[ReneMiner]

Exactly but only when executed from inside a Type Function
to be precise: Me being another type than the initial one is (currently) only possible inside a function of a type that has been Extends'ed already by another existing type

[Petr Schreiber]

Hehe,

I check here at morning, I check here at night - and what I see? Implementation party :D!

Cool stuff, I am testing it right now...


Petr

[Petr Schreiber]

Suddenly, wild idea appears. TypeOf is traditionally not returning string, so why not create something like:
GetType$(variableName)

takes any variable as input, and returns its type as string (I think it is internally stored in UCase, which is okay)
it would allow to store type... somehow, for later use with LIKE


ThinBASIC has stored the names of all types inside, he can recognize type when parsing it from text... should be doable? What do you think, Eros?

Example:


Dim v As Long

Dim s As String = GetType$(v) ' -- "s" will contain "LONG"

Dim n Like s ' -- "n" will be of LONG datatype



Petr

P.S. Abstract functions/types sound interesting!

[ReneMiner]

I ran into some problem again.
The script is very simple- on left-click into the TBGL-window there shall be randomly a circle or rect created, both different types are "managed" by some other type that stores the data to heap.
A few messages inside tell what shall be created, what get's passed and what actually gets created then - and strange about this: the first call to a type-function ->data.Identify() is correct type, second call ->data.Random() calls the wrong type within same run-through.
Just click left into the window a few times... sometimes crashes also and i dunno why...


Uses "TBGL", "console"


' + some base-type
Type t_geometric_object
sType As String ' store "TypeOf(data)" as String here
pData As DWord

Create As Function
Destroy As Function
Draft As Function ' "Draw" is occupied already by some keyword...

End Type

Function t_geometric_object.Create(ByVal sType As String) As DWord

Local data Like "" & sType ' tried without "" & ...and whatever here

PrintL "passed type: " + sType
PrintL "identify:" + data.Identify() ' this calls from the correct type

Me.sType = sType
Me.pData = HEAP_Alloc(SizeOf(data))

data.Random() ' give them some size & colour... but this calls the wrong type !

Memory_Copy( VarPtr(data), Me.pData, SizeOf(data) )
PrintL "data-size:" & SizeOf(data)

Function = Me.pData

End Function

Function t_geometric_object.Destroy() As Boolean

If HEAP_Size(Me.pData) Then Function = TRUE
HEAP_Free(Me.pData)

Me.pData = 0
Me.sType = ""

End Function

Function t_geometric_object.Draft() As Boolean
Local layover Like Me.sType At Me.pData
layover.Draft()
' draws wrong type of shape ?

End Function


' global array of geometric objects, whatever they are
Dim Shape(1) As t_geometric_object
Dim nShapes As Long = 0



' - - - - - - - - - - -
' 2 example-types

Type t_Rect
X1 As Long
Y1 As Long
X2 As Long
Y2 As Long

Colour As TBGL_TRGB

Draft As Function
Identify As Function
Random As Function ' fill in random properties


SetPos As Function
SetWidth As Function
SetHeight As Function
SetColour As Function

End Type


Function t_Rect.Identify() As String
Return "t_Rect"
End Function

Function t_Rect.Draft()

TBGL_Color Me.Colour.R, Me.Colour.G, Me.Colour.B
TBGL_Rect( Me.X1, Me.Y1, Me.X2, Me.Y2 )

End Function

Function t_Rect.Random()

Randomize

' Me.SetPos( Rnd(0, 600), Rnd(0, 420) )
' Me.SetWidth( Rnd(5, 30) )
' Me.SetHeight( Rnd(5, 30) ) ' crashing sometimes this way

Me.X1 = Rnd(20, 600)
Me.Y1 = Rnd(20, 420)
Me.X2 = Me.X1 + Rnd(5,30)
Me.Y2 = Me.Y1 + Rnd(5,30)

Me.SetColour( Rnd(40, 255), Rnd(40, 255), Rnd(40, 255) )

PrintL "X1: " & Me.X1
PrintL "Y1: " & Me.Y1
PrintL "X2: " & Me.X2
PrintL "Y2: " & Me.Y2
PrintL "I made actually a rect"

End Function

Function t_Rect.SetPos(ByVal X As Long, ByVal Y As Long)
Local lW, lH As Long
lW = Me.X2 - Me.X1
lH = Me.Y2 - Me.Y1

Me.X1 = X
Me.Y1 = Y
Me.X2 = X + lW
Me.Y2 = Y + lH

End Function

Function t_Rect.SetWidth(ByVal w As Long)
If w Then Me.X2 = Me.X1 + w
End Function

Function t_Rect.SetHeight(ByVal h As Long)
If h Then Me.Y2 = Me.Y1 + h
End Function

Function t_Rect.SetColour(ByVal R As Byte, ByVal G As Byte, ByVal B As Byte)
Me.Colour.R = R
Me.Colour.G = G
Me.Colour.B = B
End Function

' - - - - - - - - - - -
Type t_Circle
X As Long
Y As Long
Radius As Long

Colour As TBGL_TRGB

Draft As Function
Identify As Function
Random As Function

SetCenter As Function
SetRadius As Function
SetColour As Function

End Type


Function t_Circle.Identify() As String
Return "t_Circle"
End Function

Function t_Circle.Draft()

TBGL_Color Me.Colour.R, Me.Colour.G, Me.Colour.B
TBGL_NGon(Me.X, Me.Y, Me.Radius, Me.Radius * 2 + 4)

End Function



Function t_Circle.Random()
Randomize

Me.X = Rnd(30, 600)
Me.Y = Rnd(30, 420)
Me.Radius = Rnd(5, 30)

Me.SetColour( Rnd(40, 255), Rnd(40, 255), Rnd(40, 255) )

PrintL "X =" & Me.X
PrintL "Y =" & Me.Y
PrintL "Radius " & Me.Radius
PrintL "I made actually a circle"

End Function

Function t_Circle.SetCenter(ByVal X As Long, ByVal Y As Long)
Me.X = X
Me.Y = Y
End Function

Function t_Circle.SetRadius(ByVal r As Long)
Me.Radius = r
End Function

Function t_Circle.SetColour(ByVal R As Byte, ByVal G As Byte, ByVal B As Byte)
Me.Colour.R = R
Me.Colour.G = G
Me.Colour.B = B
End Function

Dim keepRunning As Boolean = TRUE


' - - - - - - - - - - -
Function TBMain()


DWord hWnd = TBGL_CreateWindowEx( "esc to end", 640, 480, 32, %TBGL_WS_WINDOWED Or %TBGL_WS_DONTSIZE Or %TBGL_WS_CLOSEBOX )
' -- Resets status of all keys
TBGL_ResetKeyState()

' -- open the window - but why? its already there...
TBGL_ShowWindow

Local lButton, rButton As Boolean ' store mouse-button-state
Local i As Long


While TBGL_IsWindow(hwnd) And keepRunning And TRUE

TBGL_ClearFrame
TBGL_RenderMatrix2D(0, 480, 640, 0)
TBGL_DepthFunc( %TBGL_ALWAYS )
TBGL_UseTexturing( FALSE )


If nShapes Then
For i = 1 To nShapes
Shape(i).Draft
Next
EndIf

TBGL_DrawFrame


' check for inputs now:
If TBGL_GetWindowKeyState(hWnd, %VK_ESCAPE) Then keepRunning = FALSE

If TBGL_GetWindowKeyState(hWnd, %VK_LBUTTON)Then
If Not lButton Then
' left-click
Randomize
nShapes += 1
ReDim Preserve Shape(nShapes)
If Rnd(0, 1) Then
PrintL "i will create some rect now"

Shape(nShapes).Create("t_Rect")


Else
PrintL "i will create a circle this time"

Shape(nShapes).Create("t_Circle")

EndIf
PrintL " - now have " & nShapes & " shapes" + $CRLF +$CRLF

EndIf
lButton = TRUE
Else
lButton = FALSE
EndIf

' If TBGL_GetWindowKeyState(hWnd, %VK_RBUTTON)Then
' If Not rButton Then
' ' right-click
' ' destroy the last one...?

' EndIf
' rButton = TRUE
' Else
' rButton = FALSE
'EndIf

Wend


End Function

minversion of course the latest ;)

[ReneMiner]

found a solution:
(remember some limitation that was in the beginning of Type-functions)

if type-functions on some absolute variable are called somehow to receive a result like


If data.Random Then
' or
success = layover.draft

then it works!

[ErosOlmi]

:)

A little bit of shapes

[ReneMiner]

Good morning @all

be warned, this might contain weird ideas :D

somehow I've got the feeling the t_geometric_object-type is something else...

it appears to be sort of a "variable-type" which allows members of a type/of an array to have individual different sub-types that even can be changed to a totally different sub-type during execution as often as wanted or needed.

The final result of the script below is the same as the attached one above, but it shows a functionality (here "Delegate") that will work the reverse way as inheritance - to call some not in the storage-type available functions on the attached types. I still have no idea how one could pass parameters dynamic to bequeath from delegate to the final executed function, but that's what this sub-type-attaching definetely would need.

I did not consider the way of sub-arrays here to stay simple - but there would be the optional way to pass a Ubound on .Create(), also pass some Index to .Delegate(), even a long to hold the ubound could be attached to the storage-type so does not need to calculate Heap_Size/SizeOf(one_element) each time. Ubound = 0 then simply means it's not an array of elements attached.

Also I changed somthing about storing "TypeOf" here - a DWord will serve, so much less memory needed for this, since every member of the array has to store this information. Passing a Dword byval to the function appears faster to me than using strings byval.
Now would be great to have a method to retrieve that StrPtr to the types name which is stored somewhere anyway, so one does not need to create the additional string-constants as I did, because they are only used to create a constant StrPtr to some string ,holding the type-name (could substitute "TypeOf" in the end somehow)



Uses "TBGL", "console"


' storage-type
Type t_geometric_object
pType As DWord
pData As DWord

Create As Function
Destroy As Function
Delegate As Function

End Type

Function t_geometric_object.Create(ByVal pType As DWord) As DWord

Local data Like Memory_Get(pType, Peek(DWord, pType-4))

'PrintL Memory_Get(pType, Peek(DWord, pType-4))' will be "t_Rect" or "t_Circle"

Me.pType = pType
Me.pData = HEAP_Alloc(SizeOf(data))

Function = Me.pData

End Function

Function t_geometric_object.Destroy() As Boolean

If HEAP_Size(Me.pData) Then Function = TRUE
HEAP_Free(Me.pData)

Me.pData = 0
Me.pType = 0


End Function

Function t_geometric_object.Delegate(ByVal sFunction As String) As Boolean

If Me.pType = 0 Or HEAP_Size(Me.pData) = 0 Then Return FALSE


Local layover Like Memory_Get(Me.pType, Peek(DWord, Me.pType-4)) At Me.pData


' would not help to call like
' Call_IfExists t_Rect.Draft() and layover.Draft() does not exist, so....

Select Case Ucase$(sFunction)
Case "DRAFT"
If layover.Draft() Then Function = TRUE
Case "RANDOM"
If layover.Random() Then Function = TRUE
End Select

End Function


' global array
Dim Shape(1) As t_geometric_object
Dim nShapes As Long = 0



' - - - - - - - - - - -
' 2 example-types
$TypeOf_t_Rect = "t_Rect" : %TypeOf_t_Rect = StrPtr($TypeOf_t_Rect) As DWord
$TypeOf_t_Circle = "t_Circle" : %TypeOf_t_Circle = StrPtr($TypeOf_t_Circle) As DWord


Type t_Rect
X1 As Long
Y1 As Long
X2 As Long
Y2 As Long

Colour As TBGL_TRGB

Draft As Function
Random As Function ' fill in random properties

SetColour As Function

End Type



Function t_Rect.Draft() As DWord

TBGL_Color Me.Colour.R, Me.Colour.G, Me.Colour.B
TBGL_Rect( Me.X1, Me.Y1, Me.X2, Me.Y2 )

Function = VarPtr(Me)

End Function

Function t_Rect.Random() As DWord

Randomize

Me.X1 = TBGL_MouseGetPosX - Rnd(5,20)
Me.Y1 = TBGL_MouseGetPosY - Rnd(5,20)
Me.X2 = 2 *(TBGL_MouseGetPosX - Me.X1) + TBGL_MouseGetPosX
Me.Y2 = 2 *(TBGL_MouseGetPosY - Me.Y1) + TBGL_MouseGetPosY

Me.SetColour( Rnd(40, 255), Rnd(40, 255), Rnd(40, 255) )

PrintL "X1: " & Me.X1
PrintL "Y1: " & Me.Y1
PrintL "X2: " & Me.X2
PrintL "Y2: " & Me.Y2
PrintL "I made a rect"
Function = VarPtr(Me)

End Function

Function t_Rect.SetColour(ByVal R As Byte, ByVal G As Byte, ByVal B As Byte) As DWord
Me.Colour.R = R
Me.Colour.G = G
Me.Colour.B = B
Function = VarPtr(Me)

End Function

' - - - - - - - - - - -
Type t_Circle
X As Long
Y As Long
Radius As Long

Colour As TBGL_TRGB

Draft As Function
Random As Function

SetColour As Function

End Type



Function t_Circle.Draft() As DWord

TBGL_Color Me.Colour.R, Me.Colour.G, Me.Colour.B
TBGL_NGon(Me.X, Me.Y, Me.Radius, Me.Radius * 2 + 4)

Function = VarPtr(Me)

End Function



Function t_Circle.Random() As DWord
Randomize

Me.X = TBGL_MouseGetPosX
Me.Y = TBGL_MouseGetPosY

Me.Radius = Rnd(5, 30)

Me.SetColour( Rnd(40, 255), Rnd(40, 255), Rnd(40, 255) )

PrintL "X =" & Me.X
PrintL "Y =" & Me.Y
PrintL "Radius " & Me.Radius
PrintL "I made a circle"
Function = VarPtr(Me)

End Function

Function t_Circle.SetColour(ByVal R As Byte, ByVal G As Byte, ByVal B As Byte) As DWord
Me.Colour.R = R
Me.Colour.G = G
Me.Colour.B = B
Function = VarPtr(Me)

End Function

Dim keepRunning As Boolean = TRUE


' - - - - - - - - - - -
Function TBMain()


DWord hWnd = TBGL_CreateWindowEx( "esc to end", 640, 480, 32, %TBGL_WS_WINDOWED Or %TBGL_WS_DONTSIZE Or %TBGL_WS_CLOSEBOX )
' -- Resets status of all keys
TBGL_ResetKeyState()
TBGL_ShowWindow

Local lButton As Boolean ' store mouse-button-state
Local i As Long


While TBGL_IsWindow(hwnd) And keepRunning And TRUE

TBGL_ClearFrame
TBGL_RenderMatrix2D(0, 480, 640, 0)
TBGL_DepthFunc( %TBGL_ALWAYS )
TBGL_UseTexturing( FALSE )


If nShapes Then
For i = 1 To nShapes
If Shape(i).Delegate "Draft" Then Nop
Next
EndIf

TBGL_DrawFrame


' check for inputs now:
If TBGL_GetWindowKeyState(hWnd, %VK_ESCAPE) Then keepRunning = FALSE

If TBGL_GetWindowKeyState(hWnd, %VK_LBUTTON)Then
If Not lButton Then
' left-click
Randomize
nShapes += 1
ReDim Preserve Shape(nShapes)
If Rnd(0, 1) Then
PrintL "i will create some rect now"
Shape(nShapes).Create(%TypeOf_t_Rect)

Else
PrintL "i will create a circle this time"
Shape(nShapes).Create(%TypeOf_t_Circle)

EndIf

If Shape(nShapes).Delegate "Random" Then Nop
PrintL " - now have " & nShapes & " shapes" + $CRLF +$CRLF

EndIf
lButton = TRUE
Else
lButton = FALSE
EndIf

Wend

End Function


this were my good-morning thoughts.

[ReneMiner]

I fear it has been overseen, so bump it.

A solution would be - as written above- to retrieve a StrPtr to the types "name" so one can simply read it out and use it.

[ReneMiner]

a little simplified - could add some more "Item"-functionalities for storing dynamic arrays, retrieving single array-elements etc.

still using a quad/2-Dword-union but another approach for TypeOf...

maybe contains some clue- maybe I'm on wrong track
perhaps I'm just thinking it's a good idea and it's not good at all.



#MINVERSION 1.9.12.0

Uses "console"

Alias Quad As Item ' reads better
Alias DWord As Heap


Function TypeOf(ByVal s As String) As Heap

Static allTypes(&H7FFF) As Heap
Static numTypes As Long

Local i As Long
' every once requested TypeOf gets some unique "ID"

If numTypes Then
For i = 1 To numTypes
If Ucase$(s) = HEAP_Get(allTypes(i)) Then Return allTypes(i)
Next
EndIf

numTypes += 1
allTypes(numTypes) = HEAP_AllocByStr(Ucase$(s))

Function = allTypes(numTypes)

End Function
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Type t_Item
dataPtr As Heap
dataType As Heap
End Type

Function NewItem(ByVal dataType As Heap) As Item

Local Me As t_Item

Local data Like HEAP_Get(dataType)


Me.dataPtr = HEAP_Alloc(SizeOf data)
Me.dataType = dataType

Function = Peek(Item, VarPtr(Me))

End Function


Function ItemData(ByRef I As Item) As Heap
Local Me As t_Item At VarPtr(I)

Function = Me.dataPtr

End Function

Function ItemType(ByRef I As Item) As String
Local Me As t_Item At VarPtr(I)

Function = HEAP_Get(Me.dataType)

End Function

' - - - - - - - - - - - - - - - - - - - - - - - - - -
Type t_Test
A As Long
B As Long
A_plus_B As Function
End Type

Function t_Test.A_plus_B() As Long
Function = Me.A + Me.B
End Function
' - - - - - - - - - - -- - -- - - - - - - - --

Dim foo As Item = NewItem TypeOf "t_Test"

Dim myData Like ItemType foo At ItemData foo
myData.A = 123
myData.B = 321

PrintL myData.A_plus_B


PrintL $CRLF + Repeat$(50,"-")
PrintL $CRLF & "key to end"
WaitKey


over the top:
no pre-overlay but instantly calling a type-function "at data as type" would be very dynamic
CallAt ItemData foo Like ItemType foo "A_plus_B" () to lResult (http://www.thinbasic.com/community/project.php?issueid=459)

[ReneMiner]

I've found a workaround so I can call Type-functions on a pointer to something, whatever it is, quite simple.



Long read ' seriously a forum-variable, keep it in mind !

:mrgreen:

I post "2 files in one" - one as the Unit that handles Items, the other part below the lines is some usage-example.

Items now are variables or dynamic arrays of any available type (except dynamic strings) that can be appended/managed through some quad-variable (2 Dwords-Union), the first Dword contains the pointer to Heap where the data is stored, the second dword contains a pointer to heap where the name of the type is stored. The good thing about items is, they can change their type so one can append different subtypes to variables of the same main-type without to change anything about the main-type.

The Item-unit takes care of enumerating types and storing the requested "type-names" too.

I refrained from using it as a real union here but have in mind that f.e. the Item.Create-result can be treated/stored in one variable as quad and how to "decode" those 2 pointers: just place some virtual Item onto a quad to retrieve data & information or to access its functions as if the Quad were some Item. You can use something like


Dim NewItem As Item

Dim frog As Quad = NewItem.Create(EnumType("t_Frog")[, Optional UBound])
Dim banana As Quad = NewItem.Create(EnumType("t_Banana")[, Optional UBound])

or


Dim myItem As Item At 0

Dim frog, banana As Quad

SetAt( myItem, Varptr(frog) )
myItem.Create(EnumType("t_Frog")[, Optional UBound])

SetAt( myItem, VarPtr(banana) )
myItem.Create(EnumType("t_Banana")[, Optional UBound])
'...
Call "" & myItem.GetType & ".myFunction"[ ([parameters])] [To Result]

or the way shown below (if your Item is not supposed to be a static udt-member nor to be a constant)

The problem with the pre-overlay is, one would need to have some virtual variable of all types and select case which one to use now, which is big effort and would cause a lot of conditions to check within a loop for example until finally the desired function on the desired type gets called.

My current solution is to check within the Type-Functions if the call came from a variable directly - so Me is defined through the call.
If not - then I know I have to use the pointer that's stored in a global here (Function_CalledFrom) and create some Me-layover in the Type-Function. And it works.
Now I can call same named Functions on any Type without the need of some pre-overlay.




' Item-Unit
' for dynamic different subtypes and arrays
#MINVERSION 1.9.12.0

Alias DWord As Heap


Function EnumType( ByVal sType As String ) As Heap

Static allTypes(&H7FFF) As Heap
Static numTypes As Long

Local i As Long

If StrPtrLen(StrPtr(sType)) < 1 Then Return 0

If numTypes Then
For i = 1 To numTypes
If Ucase$(sType) = HEAP_Get(allTypes(i)) Then Return allTypes(i)
Next
EndIf

numTypes += 1
allTypes(numTypes) = HEAP_AllocByStr(Ucase$(sType))

Function = allTypes(numTypes)

End Function
' --------------------------------------------------------------------

Type Item
pData As Heap
pType As Heap
Create As Function
Destroy As Function
GetHndl As Function
GetPtr As Function
GetType As Function
GetUBound As Function
ReDimTo As Function
End Type

Function Item.Create( ByVal asType As Heap, _
Optional ByVal lUBound As Long _
) As Quad

Local data Like HEAP_Get(asType)

If lUBound < 1 Then lUBound = 1

Me.pData = HEAP_Alloc(SizeOf(data) * lUBound)
Me.pType = asType

Function = Peek(Quad, VarPtr(Me) )

End Function

Function Item.GetHndl() As Quad
Function = Peek(Quad, VarPtr(Me) )
End Function

Function Item.Destroy() As Boolean

If HEAP_Size(Me.pData) Then
Function = TRUE
HEAP_Free(Me.pData)
EndIf
Me.pData = 0
Me.pType = 0

End Function

Function Item.GetUbound() As Long

If Not Heap_Size(Me.pData) Or Not Heap_Size(Me.pType) Then Return 0

Local data Like HEAP_Get(Me.pType) At Me.pData
Function = HEAP_Size(Me.pData)/SizeOf(data)

End Function


Function Item.GetPtr( Optional ByVal Index As Long ) As Heap

If Not HEAP_Size(Me.pData) Or Not HEAP_Size(Me.pType) Then Return 0

If Index < 2 Then
Return Me.pData
Else
Local data(Index) Like HEAP_Get(Me.pType) At Me.pData
Return VarPtr(data(Index))
EndIf

End Function

Function Item.GetType() As String
Function = HEAP_Get(Me.pType)
End Function


Function Item.ReDimTo( ByVal lUbound As Long ) As Long

' redim to same type, another element-count then, preserving assumed
' for type-change or non-preserve have to destroy and create new

Local data Like HEAP_Get(Me.pType) At Me.pData
Local lCurrentBound = HEAP_Size(Me.pData)/SizeOf(data)
Local sData As String

If lCurrentBound < lUbound Then

sData = HEAP_Get(Me.pData) & Repeat$(lUbound * SizeOf(data)- HEAP_Size(Me.pData), MKBYT$(0) )
HEAP_Free(Me.pData)
Me.pData = HEAP_AllocByStr(sData)

ElseIf lCurrentBound > lUbound Then

If lUbound < 0 Then
' negative value means to shrink the array for Abs(lUbound) elements
lUbound = lCurrentBound + lUbound
EndIf

If lUbound > 0 Then
sData = HEAP_Left(Me.pData, lUbound * SizeOf(data) )
HEAP_Free(Me.pData)
Me.pData = HEAP_AllocByStr(sData)
Else
HEAP_Free(Me.pData)
Me.pData = 0
lUbound = 0
EndIf

EndIf

' return new ubound for further usage
Function = lUbound

End Function




' ----------------------------------------------------------------------------
' END OF ITEM-UNIT
' ----------------------------------------------------------------------------





'#INCLUDE "Item.tBasicU" ' uncomment if you save the above as Unit & this seperate

Uses "console"

Global Function_CalledFrom As DWord ' seems familiar ;) ???

' have different example-types t_1 & t_2

Type t_1
X As Long
Y As Long
List As Function
SetTo As Function
End Type

Function t_1.List()

If Not #DEF(Me) Then
Local Me As t_1 At Function_CalledFrom
EndIf

PrintL "X:" + Str$(Me.X)
PrintL "Y:" + Str$(Me.Y)

End Function

Function t_1.SetTo(ByVal X As Long, ByVal Y As Long)

If Not #DEF(Me) Then
Local Me As t_1 At Function_CalledFrom
EndIf

Me.X = X
Me.Y = Y

End Function

' and another type:
Type t_2
X As Single
Y As Single
Z As Single
List As Function
SetTo As Function
End Type

Function t_2.List()

If Not #DEF(Me) Then
Local Me As t_2 At Function_CalledFrom
EndIf

PrintL "X:" + Str$(Me.X)
PrintL "Y:" + Str$(Me.Y)
PrintL "Z:" + Str$(Me.Z)
End Function

Function t_2.SetTo(ByVal X As Single, ByVal Y As Single, ByVal Z As Single)

If Not #DEF(Me) Then
Local Me As t_2 At Function_CalledFrom
EndIf

Me.X = X
Me.Y = Y
Me.Z = Z

End Function

' -- end of example types & their functions, now use it:

Dim foo(2) As Item ' At VarPtr(some_quad) thinkeable too, but keep this simple...

Dim i, j As Long ' a little for-next count

' now create some data, 3 elements of t_1

' type-name-ptr , Ubound
foo(1).Create( EnumType("t_1"), 3 )

For i = 1 To foo(1).GetUbound
Function_CalledFrom = foo(1).GetPtr(i) ' tell the function where to find Me
Call "" & foo(1).GetType & ".SetTo" (i , i)
Next i

' now create some data of t_2

foo(2).Create( EnumType("t_2") )

' oops, sorry, want 4 elements - just
foo(2).RedimTo 4


For i = 1 To foo(2).GetUbound
Function_CalledFrom = foo(2).GetPtr(i)
Call "" & foo(2).GetType & ".SetTo" (i*1.1, i*1.1, i*1.1)
Next i

' now read out all in one loop without the need of local overlay nor different absolute variables here:

For i = 1 To UBound(foo)
PrintL Str$( foo(i).GetUbound ) & " elements of type " & foo(i).GetType

For j = 1 To foo(i).GetUbound
Function_CalledFrom = foo(i).GetPtr(j)
Call "" & foo(i).GetType & ".List"
Next
Next

PrintL $CRLF + Repeat$(42, "-")
PrintL $CRLF + "Press the famous ANY-key to end"

WaitKey


:mrgreen:


incr read

If read < 2 then re-read text above script to understand better

[Petr Schreiber]

:clapping:

Rene,

you have a very creative ideas on how to use ThinBASIC. I am continuously thinking how to put them on one place to not make the lost in the sea of posts.
Maybe dedicated article section would help?


Petr

[ErosOlmi]

Hi all,

excuse me for not being present but, believe me, I follow almost all the posts and in background I'm trying to think about next features and how to implement requests I see in posts and BugTracking/Project support area.
Among other (too much) things, I'm involved into a big project at work where I'm the project leader and people expect from me direction and commitment.

Please be patient a little bit more.

Thanks
Eros

[ReneMiner]

I removed my posts that did not contain a real information fitting the topic ;)

A little "experienced knowledge" I wanted to add, concerning calling Type-Functions without refering to a type directly. If you studied the previous example there seems to be some hook:

#DEF(Me) returns 1 always after the function was called from a variable once
even when it has not been defined through the current call.

Since #DEF Alias Variable_Exists tells, Me would exist but in reality Me does not exist, accessing Me leading to crash now.



Uses "console"

Type t_Test
abc As Long
Test As Function
End Type

Function t_Test.Test()

If VARIABLE_Exists(Me) Then
PrintL "Me exists"
PrintL Str$(Me.abc)
Else
PrintL "Me does not exist"
EndIf

End Function
' - - - - - - - - - - -
Call "t_Test.Test" ' should print "Me does not exist"

Dim foo As t_Test
foo.abc = 123
foo.Test ' should print "Me exists" & "123"

Call "t_Test.Test" ' should print "Me does not exist"

WaitKey ' hehe, wait forever...

Is there a way to make the function "forget" the Me-variable as if it were never used before?

Perhaps THIS (http://www.thinbasic.com/community/project.php?issueid=459#note2709) could help

Edit: It would not be me if I would not have found a solution. Not to torture you with another pagefilling example, I simply attach it.
I have that Global Function_CalledFrom anyway: now I just made full use of it. The functions look like this now:


'...
Function t_1.List()

If Function_CalledFrom Then
Local Me As t_1 At Function_CalledFrom
Function_CalledFrom = 0
EndIf

PrintL "X:" + Str$(Me.X)
PrintL "Y:" + Str$(Me.Y)

End Function
'...

[ReneMiner]

I could have opened another thread for the following but it's an extension of the previous and all grows on the results of this thread, especially on the new Like-keyword.


Who has read it knows that I already made Items which allow to append elements or 1-dimensional arrays of elements to any quad-variable, so for example an array of some maintype can have attached different sized 1-dimensional subarrays or single elements of different subtypes without having to change anything about the maintype.


Long Read ' keep that forum-variable in mind!

Repeat

:mrgreen:
Now I created MD_Items = multidimensional items.

MD_Items need a size of 28 bytes in the first place but they have a few heaps attached to store the bounds (12 Bytes per dimension) and SizeOf(datatype)*ElementsTotal anyway.
They allow to append data of any type stored in up to a quarter million dimensions which is very naturalistic, true-to-life and often needed. No, just kidding- it leaves you the freedom to have any reasonable amount of dimensions without a limitation to care about...

A minimum of 2 dimensions is required, for 1-dimensional just stick to simple Items or set the low+high-bounds both to 1 for one of the two dimensions.
Each dimensions bounds can be in a range from -2,147,483,648 to 2,147,483,647 so means they allow to dim for example elements alike



#pseudo-syntax !!!

Dim foo(-123 to 25, 44 to 76, -99 to -13, 15)

' first dimension in a range from -123 to 25,
' second dimension in a range from 44 to 76
' third dimension in a range from -99 to -13
' fourth dimension in a range from 1 to 15

the code above is not the real syntax but just to demonstrate how one would have to understand it.

For dynamically passing indexes I simply Aliased the MKL$-functionality As MKIndex, so this allows to pass any amount of dimensions and their indexes in one parameter.

To create some multidimensional array of any type it needs to specify the type which will be enumerated by EnumType-Function, so one passes the result of EnumType together with the boundaries. There are two ways to specify bounds:

Either pass Ubounds of all dimensions only, so all dimensions indexes are 1-based as usual. That would mean to pass just one time MKIndex(...) after the EnumType().

Optional you may pass low-bounds and high-bounds so all dimensions indexes start at the passed low-bound and end at the passed high-bound.
The number of passed indexes has to match the number of dimensions always in this case, so even if lowbound of only one dimension starts with 1 you need to pass it then.

Now for the example above - this would be the syntax to use:



Dim foo as MD_Item
foo.Create( EnumType ("typename_here"), MKIndex( -123, 44, -99, 1), MKIndex( 25, 76, -13, 15) )


The first MKIndex() usually are the lowbounds and the second MKIndex() describes the upper bounds, but the create-function will take care of if you pass a higher number as first, so you can do it as you want, even mixed- as long as both have the same amount of dimensions.

To access some element of the multidimensional array you can retrieve a pointer to it using


dataPtr = <MD_Item-variable>.GetPtr( MKIndex(indexOfDimension1, indexOfDimension2 [,...]) )

or you can place some overlay like this


Local myElement Like foo.GetType At foo.GetPtr( MKIndex(1,2[,3[,...]]) )
'now can treat myElement as defined in Type



Usage-example:



#INCLUDE "Item.tBasicU"

Uses "console"

Global Function_CalledFrom As DWord ' this global will tell a type-function where to find data

' have some example-type t_Test:

Type t_test
I1 As Long ' we simply store dimensions indexes here
I2 As Long ' to recheck if all done correctly
I3 As Long

Identify As Function
SetTo As Function
End Type

Function t_Test.Identify()

If Function_CalledFrom Then
' not called from a variable of this type but from a pointer
' so Me is not dimensioned yet...
Local Me As t_Test At Function_CalledFrom
Function_CalledFrom = 0
EndIf

PrintL "My Index: (" & Me.I1 & ", " & Me.I2 & ", " & Me.I3 & ")"

End Function

Function t_Test.SetTo(ByVal I1 As Long, ByVal I2 As Long, ByVal I3 As Long)

If Function_CalledFrom Then
Local Me As t_Test At Function_CalledFrom
Function_CalledFrom = 0
EndIf

Me.I1 = I1
Me.I2 = I2
Me.I3 = I3

End Function
' ------------------------------------------------------
' now create some multi-dimensional Item

Dim foo As MD_Item
foo.Create( EnumType("t_Test"), _ ' of type t_test
MKIndex(-1,-2, -3), _ ' lowbounds (3 dimensions)
MKIndex( 1, 2, 3 ) _ ' highbounds (3 dimensions)
)

'should have "foo(-1 to 1, -2 to 2, -3 to 3)" now
' 3 * 5 * 7
' ======================
' 105 elements of t_Test

Dim e, i, j, k As Long

For i = 1 To foo.nDims ' .nDims tells us the number of dimensions
PrintL "Dimension " & i & ": " & foo.GetLowBound(i) & " To " & foo.GetHiBound(i)
Next
PrintL
PrintL "Have a total of " & foo.ElementsTotal & " elements of " & foo.GetType

PrintL $CRLF + Repeat$(42, "-")
PrintL $CRLF + "Press any key to continue" + $CRLF
WaitKey

For i = foo.GetLowBound(1) To foo.GetHiBound(1)
For j = foo.GetLowBound(2) To foo.GetHiBound(2)
For k = foo.GetLowBound(3) To foo.GetHiBound(3)
e += 1
PrintL "Element " & e & $TAB & i, j, k

' request pointer to element(i,j,k) and store to global:
Function_CalledFrom = Foo.GetPtr( MKIndex(i, j, k) )
' call type-function, stored global will be used in that function to place Me:
Call "t_Test.SetTo"(i, j, k)
Next
Next
Next

PrintL $CRLF & "do some checks now:" & $CRLF

' check element 0,0,0
PrintL "should print: My Index: (0, 0, 0)"
Function_CalledFrom = Foo.GetPtr( MKIndex(0, 0, 0) )
Call "t_Test.Identify"

' check element 1,1,1
PrintL "should print: My Index: (1, 1, 1)"
Function_CalledFrom = Foo.GetPtr( MKIndex(1, 1, 1) )
Call "" & foo.GetType & ".Identify"

' check element -1,-1,-1
PrintL "should print: My Index: (-1, -1, -1)"
Function_CalledFrom = Foo.GetPtr( MKIndex(-1, -1, -1) )
Call "t_Test.Identify"

' check element "not specified"
PrintL "this is the very first element:"
Function_CalledFrom = Foo.GetPtr()
Call "t_Test.Identify"

PrintL $CRLF + Repeat$(42, "-")
PrintL $CRLF + "Press the famous ANY-key to end"

WaitKey



There's no Redim-functionality for MD_Items but for non-preserve simply destroy and create new.
Also Redim Preserve can be achieved:
As first create temporary a new MD_Item in the desired new dimensions, then for-next-loop through all dimensions in boundaries that are common to both data-fields and place the data to preserve to the temp-element using


Memory_Set( <tempMD_Item>.GetPtr( MKIndex(i,ii[,...]) ), _
Memory_Get( <myMD_Item>.GetPtr( MKIndex(i,ii[,...]) ), SizeOf(typename_here) ) _
)


finally:


Memory_Swap( Varptr(<myMD_Item>), Varptr(<tempMD_Item>), SizeOf(MD_Item) )
' can destroy the temporary MD_Item which contains the "old information & data" now
<tempMD_Item>.Destroy()

and Redim Preserve is done...

:mrgreen:


incr Read
Until Read >= %Understand

The attached unit contains both, Items and MD_Items
#MinVersion 1.9.12.0

[ReneMiner]

coming to something totally different than the above, but since Like-Keyword was invented here somehow I have some additional idea to use it somewhere else, could be very useful, probably also using As



Uses "console"

String A = "Long"
Long B = 123

PrintL str$( Peek( Like A, Varptr(B) ) )
' PrintL str$( Peek( As B, VarPtr(B) ) )

WaitKey

should print out 123 :D

[Petr Schreiber]

Hi Rene,

this function could do that for you :):


Uses "console"

String A = "Long"
Long B = 123

Long x = LikePeek( A, VarPtr(B) )
PrintL x

WaitKey

Function LikePeek(vType As String, pVariable As DWord) As String

Dim x Like vType

String rawResult = Peek$( pVariable, SizeOf(x) )

Select Case MCase$(vType)
Case "Byte"
rawResult = CVBYT(rawResult)

Case "Currency"
rawResult = CVCUR(rawResult)

Case "Double"
rawResult = CVD(rawResult)

Case "Dword"
rawResult = CVDWD(rawResult)

Case "Ext", "Extended"
rawResult = CVE(rawResult)

Case "Integer"
rawResult = CVI(rawResult)

Case "Long"
rawResult = CVL(rawResult)

Case "Quad"
rawResult = CVQ(rawResult)

Case "Single"
rawResult = CVS(rawResult)

Case "Word"
rawResult = CVWRD(rawResult)

End Select

Return rawResult

End Function


Petr

[ReneMiner]

so to say as this:


#MINVERSION 1.9.12.0

Uses "console"

String A = "Long"
Long B = 123

Function PeekLike(ByVal sType As String, ByVal pData As DWord) As String

Local x Like sType At pData

Function = x

End Function

PrintL PeekLike A, VarPtr(B)



PrintL $CRLF & "Any key to end"
WaitKey


that returning string for dynamic types is nice hack :D
now can peek udts and standard-types...

[Petr Schreiber]

Haha,

that is even simpler. Cool code :)


Petr

[ReneMiner]

just for fun i did the reverse operation, that is to "poke" a numerical string as different types to some place, really great, now i know how to bind user-data to a listview-alike control...




#MINVERSION 1.9.12.0

Uses "console"

DWord someHeap = HEAP_Alloc(64)


Function PeekLike(ByVal sType As String, ByVal pData As DWord) As String

Local x Like sType At pData

Function = x

End Function

Function PokeLike(ByVal sType As String, ByVal pData As DWord, ByVal sVal As String ) As String

Local x Like sType At pData

If UCase$(sType) = "STRING" Then
x = sVal
Else
x = Val( sVal )
EndIf

Function = x

End Function


PokeLike "Ext", someHeap, "123.456"

PrintL PeekLike "Ext", someHeap


PrintL $CRLF & "any key to end"
WaitKey