ARRAY-ideas

[ReneMiner]

not a completely new idea (mentioned already in some other thread) but i would like to use the powers of Array Scan on data stored at heap-memory.

How? Nearly the same way it works for arrays of dynamic strings currently. As far as i know a dynamic-string-array is just an array of stringpointers - right?

I want to have an array of heap-pointers and scan the content of the pointed heap-areas.
small example:



DWord myPtrs = HEAP_AllocByStr(MKDWD$( _
HEAP_AllocByStr("this"), _
HEAP_AllocByStr("is an"), _
HEAP_AllocByStr("array") ) )

Dim vPtr(HEAP_Size(myPtrs)/4) As DWord At myPtrs

' tell somehow its an array of pointers
' so i simply insert keyword Ptr here:

PrintL Array Ptr Scan vPtr, Collate Ucase, = "ARRAY"

' should print 3 now

PS. if a pointer contains 0 it should not throw error-
and btw. change the behaviour of heap-memory and disable allocating sizes of less than 1 byte/ empty strings!

________________________________________________________________________

Oh yes- another Array-idea were to have some way to loop through all elements of an array without the need of additional counter-variables.
something alike


With [Each Element Of] Array myArray
'...do something...
' would be limited to arrays of udt only
End With


' or another way:
For Array myArray
' now myArray is an overlay at current element!
' (no limitation as above, so can use arrays of byte, long etc)
Next


(see more detailed examples for the second way here (http://www.thinbasic.com/community/showthread.php?12445-my-current-GUI-project&p=91392#post91392))

[John Spikowski]

Rene,

I can only imagine what you could do with thinBASIC if you had access to the source. Maybe it's time Eros opens the door to serious advocates of the language. If that isn't a choice Eros is willing to make, you should find yourself an open source project and make these contributions count.

John

[ErosOlmi]

@John,
it is admirable how you always try to bring people on your side every time someone suggest new features not directly present into a programming language.
I hope you are payed for this job.
Well done :eusaclap:


@Rene,
I will check if I can add the first request. It is very very specific command. I would like something more general to be used by the average programmer. Will see.
Regarding the second request, I already started a FOREACH command but not yet finished.

Ciao
Eros

[ReneMiner]

thanks for your reply... makes me feel tB is collecting energy for an upcoming boost in future. Actually the first (Array Scan)-request is the more important one to me- there a quite a few ways to loop through an array available already - the suggest was more because it's possible and fits the topic.

The other thing - inbetween the lines - seems the most important to me - make Heap_Size < 1 unavailable please. I always use Heap_Size to detect if Heap at a certain pointer exists at all since there's no Heap_Exists and if a Heap_Size can not be below 1 then it would not be necessary to check any else than size to test the existence/validity of some heap-memory.
to delete some old memory i check mostly like that since there's no other method:


if Heap_Size(x) then
Heap_Free(x)
x = 0
endif

but if Heap_Size(x) = 0 then i have a lost orphan pointer and some 0-len-memory-block stays allocated. So to me seems very important that Heap_Size of 0 Bytes are not accepted/allocated and simply return 0 on Heap_Alloc/Heap_ReAlloc/Heap_AllocByStr if size of data < 1

[John Spikowski]

@John,
it is admirable how you always try to bring people on your side every time someone suggest new features not directly present into a programming language.
I hope you are payed for this job.
Well done :eusaclap:


Excuse me but where did you read me asking Rene to join me or the Script BASIC project? I said find an open source project. Please don't start reading between the lines. There is already enough of that going around.

A simple answer how you feel about opening the source would have been sufficient.

[ErosOlmi]

Ciao Renè,

as a starter, please find here enclosed an updated thinCore.dll.
To install just unzip it into \thinBasic\ directory replacing your current thinCore.dll.

New syntax for HEAP_AllocByStr is the following:
ptr = HEAP_AllocByStr(String [, AllowEmptyStringAllocation])

In case of empty string, now allocation will take place (function will return zero) unless optional param "AllowEmptyStringAllocation" will be %TRUE


Also implemented Heap_End as requested at http://www.thinbasic.com/community/project.php?issueid=471


Actually I'm finishing to develop and document two new thinBasic modules: Excel and AdoDB. Quite excited about that.
As soon as I will finish (documentation included) I will publish thinBasic 1.9.14. Around end of next week.

In the meantime I will think about your recent requests. "Array Ptr Scan ..." is quite easy, maybe I will be able to include in this round.

Ciao
Eros

[ErosOlmi]

Ciao again Renè.

Attached a new thinCore.dll where I've developed a preliminar version of your ARRAY SCAN ... PTR ... request.

Syntax is the following (PTR just after array name):

Uses "console"

'---Allocate a string that is a sequance of some DWORDs.
'---Each DWORD represents a PTR to a heap memory area where a string is allocated
DWord myPtrs = HEAP_AllocByStr( _
MKDWD$( _
HEAP_AllocByStr("this") , _
HEAP_AllocByStr("is an") , _
HEAP_AllocByStr("array") , _
HEAP_AllocByStr("of") , _
HEAP_AllocByStr("some") , _
HEAP_AllocByStr("strings") _
) _
)


'---Define a virtual array over-imposing its structure to the previous allocated pointer
Dim vPtr(HEAP_Size(myPtrs)/SizeOf(DWord)) As DWord At myPtrs

'---Now scan that area using the new PTR option.
'---PTR tells to ARRAT SCAN that the DWORD is in reality a pointer to some memory area
'---where to find a heap allocation of a string to be used for comparison.
'---ATTENTION: this will work only for DWORD arrays!!!!!!!!!!!!!!!!!!!!!!!
PrintL Array Scan vPtr Ptr, Collate Ucase, = "SOME"


PrintL "Press any key"
WaitKey




Let me know if you find any bug. I didn't make much tests.

Ciao
Eros

[ReneMiner]

cooool - very excited - it feels like being a child having birthday :D
- still testing and trying -

Heap_End also very nice working - now can virtually go "For Each" without the need of allocating additional variables nor calculations



Uses "console"

DWord myPtrs = HEAP_AllocByStr( _
MKDWD$( _
HEAP_AllocByStr("this") , _
HEAP_AllocByStr("is an") , _
HEAP_AllocByStr("array") , _
HEAP_AllocByStr("", TRUE) , _
HEAP_AllocByStr("") , _
HEAP_AllocByStr("some") , _
HEAP_AllocByStr("strings") _
) _
)

'test Heap_End
Dim vSurf As DWord At myPtrs

While VarPtr(vSurf) < Heap_End(myPtrs)
PrintL Hex$(vSurf,8) & " : " & HEAP_Get(vSurf)
SetAt( vSurf, VarPtr(vSurf) + SizeOf(vSurf))
Wend

PrintL $CRLF & Repeat$(42, "*")
PrintL $CRLF & "Any key to end"
WaitKey

[ReneMiner]

Got an Error! But not related to the current topic but while experimenting with new tB-functions.
This is my testing script, requires the heap-unit below and thinCore.dll above anyway since the unit makes use of the new Array Scan Ptr-functionality




Uses "console"
#INCLUDE "Heap.tBasicU"

' some simple udt for test
Type t_vec3d
X As Double
Y As Double
Z As Double
SetPos As Function
End Type

Function t_Vec3d.SetPos(ByVal X As Double, ByVal Y As Double, ByVal Z As Double)
Me.X = X
Me.Y = Y
Me.Z = Z
End Function

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

Dim foo As Heap

' create some space to store different things at foo
foo.AllocLike("Heap", 3)

' first heap at foo shall contain a string
Dim vHeap Like foo.GetType At foo.pData
vHeap.Be("Hello World", "String")

' next heap at foo shall contain some longs
SetAt(vHeap, VarPtr(vHeap) + SizeOf(vHeap))
vHeap.Be(MKL$(1,2,3,4,5), "Long")

' next heap at foo shall contain 3 vecs
SetAt(vHeap, VarPtr(vHeap) + SizeOf(vHeap))
vHeap.allocLike("t_Vec3d", 3)
' fill in some udt-data
Dim vVec Like vHeap.GetType At vHeap.pData
vVec.SetPos(1.1, 1.2, 1.3)
SetAt( vVec, VarPtr(vVec)+ SizeOf(vVec) )
vVec.SetPos(2.1, 2.2, 2.3)
SetAt( vVec, VarPtr(vVec)+ SizeOf(vVec) )
vVec.SetPos(3.1, 3.2, 3.3)

' now reset to first heap
SetAt( vHeap, foo.pData )
While VarPtr(vHeap) < foo.GetEnd

PrintL "Type is " & vHeap.GetType

' replace below
' "HEAP_Get(vHeap.pType)" with "vHeap.GetType()" to have error
'the following line is the one:
Select Case HEAP_Get(vHeap.pType)
Case "STRING"
PrintL "contains :" & vHeap.Is
Case "LONG"
Dim vLong As Long At vHeap.pData
While VarPtr(vLong) < vHeap.GetEnd
PrintL vLong
SetAt(vLong, VarPtr(vLong) + SizeOf(Long))
Wend
Case "T_VEC3D"
SetAt(vVec, vHeap.pData)
While VarPtr(vVec) < vHeap.GetEnd
PrintL "X:" & vVec.X
PrintL "Y:" & vVec.Y
PrintL "Z:" & vVec.Z

SetAt(vVec, VarPtr(vVec) + SizeOf(vVec))
Wend
End Select
' push forward to next heap
SetAt(vHeap, VarPtr(vHeap) + SizeOf(vHeap) )
Wend

PrintL $CRLF & Repeat$(42, "*")
PrintL $CRLF & "Any key to end"
WaitKey


check line 53 of the script.


Select Case [some type-function-result]

results in crash, no matter if parenthesis used or not. I don't know if that is always the case since i discovered this as a reason of error for the first time

[ErosOlmi]

Rene,

I think the crash is related to the fact I never adjusted
SELECT CASE <...>
when <...> is a UDT function.

When SELECT CASE <...> is fired, ThinBASIC try to understand if the next expression (the one inside <...>) is a numeric expression or a string expression.
After that it is able to know that all internal CASE ... are one type or the other.

My idea is that direct UDT functions in a SELECT statements are not supported and for this reason it does not know that vHeap.GetType will return a string.

It should be an easy FIX but ... :(
Actually I'm still at work after 14 hours working.
I still have 1 hour drive at home.
If I will have the forces I will check this night or (maybe) tomorrow, sorry.

Ciao
Eros

[ErosOlmi]

OK, I could not resist!

It was like I expected.
Please find here attached a new thinCore.dll

Let me know if it works.

Ciao
Eros

[ReneMiner]

here it works - and tB becomes better and better :)

[Petr Schreiber]

Hehe,

Eros at his best :) Great!

I have one suggestion regarding syntactic sugar. To keep in line with Dim..At, SetAt, GetAt...

What about changing the syntax of "ARRAY SCAN pointerToMemory PTR" to "ARRAY SCAN AT pointerToMemory"?


Petr

[ReneMiner]

Hi Petr, i think At is more like sign for an absolute variable while Array Scan myArray Ptr can be a real or some virtual array so At would be a little confusing while Ptr just tells Array Scan that its an array of pointers that point the data to scan.

The reason why you thought this might be because the above examples use as less real variables as necessary since they need time to Dim and allocate space. I'm convinced an overlay at some existing data is always the way to prefer when it comes to fast script execution

[ErosOlmi]

Ciao Petr,

I thought about that but here "pointerToMemory" is not a pointer to memory but an array variable from which ARRAY SCAN detect array variable type an array number of elements without which it would be impossible to perform the scan. So I used PTR after array name to tell that DWORD array is a DWORD array of pointer allocated by HEAP_AllocByStr and not just other generic allocation method. Knowing that, I can use HEAP functionalities to detect real memory area and length of the allocated memory.

So ... It is a very specific ARRAY SCAN

Maybe I can add HEAP keyword in order to clarify it better. Something like ARRAY SCAN HEAP myDWordArray ...




Sent from my iPhone using Tapatalk

[ReneMiner]

Eros I think Ptr-keyword is fine just for this one usage here. It were something else if Heap would be a keyword already but since it's not i would refrain from adding a keyword here.

[ReneMiner]

some speedtest to compare the way i used before and now ... and i'm happy about the result,
now needs around 15% to 20% of the time it needed before to find a certain element:

#MinVersion 1.9.13.0 + new thinCore.dll ( attachement a few posts above )


Uses "console"

' heap-scan-speedtest

Function TBMain()

Local myPtr(&H4000) As DWord
Local i, j As Long
Local startingTime, neededTime As Quad
Local sToFind As String

Randomize
HiResTimer_Init

PrintL "filling in data now..."

For i = 1 To UBound(myPtr)
myPtr(i) = HEAP_AllocByStr("Mississippi" & Hex$(i,8))
Next

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

PrintL "do 255 scans the old way:"

startingTime = HiResTimer_Get
For i = 1 To 255
sToFind = Ucase$("mississippi" & Hex$(Rnd(1, UBound(myPtr)), 8))
For j = 1 To UBound(myPtr)
If Ucase$(HEAP_Get(myPtr(j))) = sToFind Then
Print "." ' <<< if comment this then <<<
Exit For
EndIf
Next
Next
PrintL
neededTime = HiResTimer_Get - startingtime
PrintL "Time needed : " + Format$(neededTime / 1000000, "#.0000")
PrintL $CRLF & Repeat$(42, "_")

' - - - - - - - - - - - - - - - - - - -
PrintL "now 255 scans the new way:"

startingTime = HiResTimer_Get
For i = 1 To 255
sToFind = Ucase$("mississippi" & Hex$(Rnd(1, UBound(myPtr)), 8))
If Array Scan myPtr Ptr, Collate Ucase, = sToFind Then
Print "." ' <<< comment this too <<<
EndIf
Next
PrintL
neededTime = HiResTimer_Get - startingtime
PrintL "Time needed : " + Format$(neededTime / 1000000, "#.0000")

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

PrintL $CRLF & Repeat$(42, "*")
PrintL $CRLF & "Any key to end"
WaitKey

End Function


(you may comment lines 30 & 47 to subtract the printing-time)

Results may differ due randomized values to check for, but the felt average on my system = 1.0 / 5.5

[ErosOlmi]

mmmmm :grrrr:

I'm not happy about this speed difference: from 3.3 sec to 0.6 is not enough :)

I will see if I can improve it using your example.

:comp4:

[ErosOlmi]

Dear Rene,

can you please check the attached new thinBasic Core engine and see new speed in ARRAY SCAN ... PTR ... ?

:rolleyes:

[ReneMiner]

when i tried out my current gui-project (http://www.thinbasic.com/community/showthread.php?12445-my-current-GUI-project&p=91486#post91486) i discovered that tB instantly crashes on startup. i does not happen if i use the previous thincore-version.

Find array-scan-functions in unit-file GUI.tBasicU, all called like t_GUI.Enum...()

[ErosOlmi]

Hi Rene,

speed improvement of about 10x was achieved using pointers in string comparison instead of getting strings from HEAP comparing it as a string.
I should have done some mistake or there is a string situation I was not expecting.

Can you be so kind to send me by mail at support@thinbasic.com a zip file with all the sources giving error so I can test?

Thanks
Eros

[ReneMiner]

i had a link to it in the last post, but because it's you i attach the attachement for you here again

PS. probably memory-compare could lead to the string to search for is larger than heap-size?

PPS. start one of the testprojects to test,
find array-scan-functions in unit GUI.tBasicU all called like t_GUI.Enum...()

#minVersion 1.9.13.0 + thinCore.dll from september 10th

[ErosOlmi]

Hi Rene,

I'm making a lot of testing but it seems that the GPF is generated not by my code but in some situation when ARRAY SCAN ... PTR does not return any index because the string was not found while the script in reality is sure the index will be valid.

In any case, I'm not 100% sure about that: your code is very complex and I'm not able to debug till the exact point where the GPF occurs.

I'm going on investigating.
Eros

[ReneMiner]

ok, i found something - seems array scan not always can find existing data when collate ucase, i made some example


Uses "console"


%vt_Byte = EnumType("Byte") As DWord
%vt_Integer = EnumType("Integer") As DWord
%vt_Word = EnumType("WORD") As DWord
%vt_DWord = EnumType("DWORD") As DWord
%vt_Long = EnumType("LONG") As DWord
%vt_Quad = EnumType("QUAD") As DWord
%vt_Single = EnumType("SINGLE") As DWord
%vt_Double = EnumType("DOUBLE") As DWord
%vt_Ext = EnumType("EXT") As DWord
%vt_Extended = EnumType("EXTENDED") As DWord
%vt_Currency = EnumType("CURRENCY") As DWord
%vt_String = EnumType("String") As DWord
%vt_Heap = EnumType("HEAP") As DWord

PrintL "types are enumerated now"
PrintL
PrintL HEAP_Get(%vt_Byte)
PrintL HEAP_Get(%vt_Integer)
PrintL HEAP_Get(%vt_Word)
PrintL HEAP_Get(%vt_DWord)
PrintL HEAP_Get(%vt_Long)
PrintL HEAP_Get(%vt_Quad)
PrintL HEAP_Get(%vt_Single)
PrintL HEAP_Get(%vt_Double)
PrintL HEAP_Get(%vt_Ext)
PrintL HEAP_Get(%vt_Extended)
PrintL HEAP_Get(%vt_Currency)
PrintL HEAP_Get(%vt_String)
PrintL HEAP_Get(%vt_Heap)

PrintL $CRLF & "key to continue"
WaitKey

PrintL "request integer :" & HEAP_Get(EnumType("integer", TRUE)) 'should print integer
PrintL "request currency:" & HEAP_Get(EnumType("CurrenCy", TRUE)) 'should print currency
PrintL "request double :" & HEAP_Get(EnumType("Double", TRUE)) 'should print double
PrintL "request quad :" & HEAP_Get(EnumType("Quad", TRUE)) 'should print quad
PrintL "request String :" & HEAP_Get(EnumType("String", TRUE)) 'should print string


PrintL $CRLF & "key to end"
WaitKey

Function EnumType( ByVal sName As String, _
Optional ByVal testExist As Boolean = FALSE _
) As DWord

' this funtion will store any passed string as is
' and return it's "unique number":
' a pointer to heap containing the string
' as passed for the very first time but
' this function is NOT case-sensitive!


Static allNames(&H3FFF) As DWord
Static numNames As Long
Static i As Long

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

i = Array Scan allNames Ptr, Collate Ucase, = Ucase$(sName)

If i Then
Return allNames(i)
Else
If testExist Then Return 0
EndIf

numNames += 1
allNames(numNames) = HEAP_AllocByStr(sName)

Function = allNames(numNames)
End Function


(the function was usually made to keep track of controls names - but for this example i used some other data i already had present)

[ErosOlmi]

Here it is the fix, I hope.

As often happens: stupid error (in this case very stupid) difficult to find.

Let m e know
Eros

[ReneMiner]

cool :) everything runs fine- all 3 scripts testet ( the huge one and both of this thread )

listen to my current favourite track (https://soundcloud.com/excision/excision-shambhala-2014-mix) while enjoying the success

[ReneMiner]

one question to that now, i assumed it would work but obviously not as i expected, assume toFind is some udt-variable consisting of a few dwords or longs and i want it only to compare 2 * 4 bytes starting at the 5th byte


Long Index = Array Scan vPtr Ptr, Byte(5, 8), = toFind


it does not seem to find the data matching this pattern - i have some small testscript attached, it's around line 138

[ReneMiner]

i isolated a little and found the following:


Uses "console"

Type some_Data
pType As DWord
pName As DWord
Index As Long
End Type

Dim foo(5) As DWord
Long i
Dim dummy As some_Data At 0

' fill in some data
For i = 1 To UBound(foo)
foo(i) = HEAP_Alloc(SizeOf(dummy))
SetAt( dummy, foo(i) )
dummy.pType = i * 100
dummy.pName = i * 200
dummy.Index = i
Next

Dim toFind As some_Data
toFind.pName = 600
toFind.Index = 3
' search for byte 5 to 12 only, should print 3:
PrintL "1. found " & Str$( Array Scan foo Ptr, Byte(5, 8), = toFind )
' search for whole data, should print 0
PrintL "2. found " & Str$( Array Scan foo Ptr, = toFind )

' now make the type match
toFind.pType = 300

' search for byte 5 to 12 only, should print 3:
PrintL "3. found " & Str$( Array Scan foo Ptr, Byte(5, 8), = toFind )
' search for whole data, should print 3
PrintL "4. found " & Str$( Array Scan foo Ptr, = toFind )

WaitKey


if pType does not match even if meant to be ignored - it affects the scan-result.

[ReneMiner]

Seems the Byte-option gets ignored completely if the Ptr-option is used, test below proves that Byte-option works quite well on other data



Uses "console"

Type some_Data
pType As DWord
pName As DWord
Index As Long
End Type

Dim foo(5) As some_data
Long i

' fill in some data
For i = 1 To UBound(foo)
foo(i).pType = i * 100
foo(i).pName = i * 200
foo(i).Index = i
Next

Dim toFind As some_Data

toFind.pName = 600
toFind.Index = 3
' search for byte 5 to 12 only, should print 3:
PrintL "expect 3, found " & Str$( Array Scan foo, Byte(5, 8), = toFind )
' search for whole data, should print 0
PrintL "expect 0, found " & Str$( Array Scan foo, = toFind )

' now make the type match
toFind.pType = 300

' search for byte 5 to 12 only, should print 3:
PrintL "expect 3, found " & Str$( Array Scan foo, Byte(5, 8), = toFind )
' search for whole data, should print 3
PrintL "expect 3, found " & Str$( Array Scan foo, = toFind )


WaitKey

[ErosOlmi]

Hi Rene,

I will check later when back home.

Ptr option is a very special option and is intended to be used only for arrays of pointers of something that is allocated using heap memory. Nothing more and nothing else. Very very specific case.
In any case I will check you examples and see what I can do, add or fix.

Ciao
Eros

[ReneMiner]

It's the case- all data to scan is stored at heap - but data can be larger (different extended types probably) but all follows the basetype-pattern.

So i have ptrs to heap-memory but i dont want to scan for the whole udt but just a certain sequence of bytes...

now get's a little

:offtopic:
but in the meantime i had another "nice idea" of dynamic memory-management- nosy users simply check the attached script to see what i'm experimenting with... heap of course...

using one udt that consists of one LONG as Index only and a few Static Dwords,


Type Memory
Index As Long ' now what's that.... :D

Static Dataptr As DWord ' gets set by type-functions
' as an additional "Function-Result"

Static hDataPtrs As DWord ' two parrallel arrays that [Ptr1;Ptr2;Ptr3;...]
Static hDataTypes As DWord ' contain dataptrs & datatypes [Typ1;Typ2;Typ3;...]

Static hTypeNames As DWord ' a list of all type-name-ptrs

Alloc As Function ' this will (re)allocate some memory and optional assign value
Free As Function ' will empty this slot
LayOver As Function ' prepare Layover at
Get$ As Function ' simply returns data as string
GetPtr As Function ' returns pointer to data or element if array
GetUBound As Function ' returns ubound
End Type



one of those dwords acts as additional function-result from the types functions to get loaded with the requested pointer
three hold pointers to heap where 3 dword-arrays are stored, one keeps just track of the enumerated typenames,
the 2 other heaps are the same size and the upper one holds the dataptr while the one below holds a pointer to where the type can be read out - so both values at the same Index wich is "myMemory.Index"

[ErosOlmi]

Renè,

sorry for the delay but in this time work (:cry:) and family come first.
As a starter, please find here attached a thinCore.dll that should allow ARRAY SCAN ... PTR, BYTE() option.
If you confirm it is working as you expect I will go on adding more options to array scan that can help you in this job.

As soon as possible I will release a full thinBasic 1.9.14 version.

Ciao
Eros

ATTACHED file removed: see next post

[ErosOlmi]

A little update before going to a loooong working day: added Type_Exists as requested here: http://www.thinbasic.com/community/project.php?issueid=473&filter=all#note2764

[ReneMiner]

really great- now i have some material to test and a few scripts to write :) - so far all my older scripts that i tested now are still working- in the next few hours i think i'll have some nice testing & experimental session

grazie mille

[ErosOlmi]

"Grazie mille" to you for always posting interesting challenges and sorry for my chronic be late in this period. Christmas holidays are not so far and I hope to have some full time to dedicate to ThinBASIC


Sent from my iPhone using Tapatalk

[ReneMiner]

ok, all testing went fine - its really cool, here i have some attempt (needs a little more works) what it is good for. Imagine you want to have different types of controls that all Extend some basetype- only thing they have in common is something like Name & Index. Now this allocates and manages all the data so each occupied "memory-ptr-slot" can be accessed either by its name & index from any foreign local as organized_Heap dimensioned variable or by it's ID through the original variable/Me.

This organized_Heap is meant to store single elements only where it makes sense to store type & give them names.

This is the main-"testing-script" , needs attached unit below (where already Type_Exists in use too) & thinCore above


Uses "console"
' needs 1.9.13/14 + latest thincore.dll

#INCLUDE "organized_Heap.tBasicU"

' this the base-type to store data to give an overview here,
' any data to store at organized_Heap
' has to be an extension of:

'Type organized_Data

' pType As DWord ' this gets assigned a pointer where the type can be read out
'
' pName As DWord ' this will contain a pointer where a name can be read out
' Index As Long ' this is an individual index for same named data
'
' GetType As Function
' GetName As Function

' Free As Function ' basetype-function is empty
' since there's no additional data to free

' GetID As Function ' the data can tell which slot it's in
'End Type

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

' this is what organized_Heap looks like: (Size of 1 Long!)
' Type organized_Heap
' ID As Long ' = Position/Slot in Dword-List at hDataPtrs

' Static DataPtr As DWord ' get's set by type-functions

' Static hDataPtrs As DWord ' stores pointer to a list of pointers,
' ID tells which is meant

' Static hAllTypes As DWord ' store where to find a list of all types
' Static hAllNames As DWord ' a list of names

' Create As Function
' Free As Function
' GetPtr As Function ' returns pointer, sets DataPtr also
' GetID As Function ' retrieve an ID from a pointer
' LayOver As Function ' prepare layover, set DataPtr

'End Type


' ----------------------------------------------------------------------------------
' TEST:
' --------------------------

Type organized_Node Extends organized_Data
hText As DWord
' keep test-type-extension simple
'Parent As Long
'Expanded As Boolean
'...
GetText As Function
SetText As Function
End Type

Function organized_Node.GetText() As String
Function = HEAP_Get(Me.hText)
End Function

Function organized_Node.SetText(ByVal sText As String) As String
If HEAP_Size(Me.hText) Then
HEAP_Free(Me.hText)
EndIf
Me.hText = HEAP_AllocByStr(sText)
Function = sText
End Function

Function organized_Node.Free()
' create a list of children and kill them all...
' and
If HEAP_Size(Me.hText) Then
HEAP_Free(Me.hText)
Me.hText = 0
EndIf

End Function


Function TBMain()

Dim myHeap(8) As organized_Heap
Local i As Long
' starting simple pass sType as String, optional sName As String, Index As Long

Local lData Like myHeap(1).Create("Organized_Data", "myData", 1) At myHeap(1).DataPtr

PrintL lData.GetID, lData.GetType, lData.GetName, lData.Index

For i = 4 To 2 Step - 1
myHeap(i).Create("organized_data", "myData") ' - should index automatic...
' btw. negative indexes or 0 are possible too but 1 based by default
SetAt( lData, myHeap(i).DataPtr )
PrintL lData.GetID, lData.GetType, lData.GetName, lData.Index
Next

Dim myOtherHeap As organized_Heap
PrintL "now:"
myOtherHeap.Create("organized_data", "myOtherData")
SetAt( lData, myOtherHeap.DataPtr )
Print lData.GetID, lData.GetType, lData.GetName, lData.Index
PrintL "... stored somewhere else"

' where ever the data is noded, we'll find it:

Local Heap As organized_Heap At 0 ' just virtual will serve the purpose, so not even space allocated!

Dim vData Like Heap.Layover("myData", 4) At Heap.DataPtr
PrintL "requested myData 4 by name:"
PrintL vData.GetID, vData.GetType, vData.GetName, vData.Index

' now attach some different types to myHeap(...)

Local lNode As organized_Node At 0
For i = 1 To 4
myHeap(i+4).Create("organized_Node", "myNode")
SetAt( lNode, Heap.DataPtr ) ' now why does this work :D :D :D ?
lNode.SetText("I'm node" & Str$(i) )
Next
PrintL

' now get crazy, i erase all my information:
ReDim myHeap(1)
' still have the virtual Heap At 0...
PrintL
' but none is lost...

Local whatever Like Heap.LayOver("myData", 3) At Heap.Dataptr
PrintL whatever.GetID, whatever.GetType

' have already some absolute variable here known as lNode

SetAt( lNode, Heap.GetPtr("myNode", 1) )

PrintL lNode.GetID, lNode.GetText

' now communicate with heap through "i"
SetAt( Heap, VarPtr(i) ) ' <<< check this

' re-allocate where myNode 3 was:

i = Heap.GetID( Heap.GetPtr("myNode", 3) )
Heap.Create("organized_Data", "newNameToo")

i -= 1
Dim foo Like Heap.Layover() At Heap.DataPtr
PrintL "this should be node 2 :" & foo.GetText

Heap.Free() ' oh no...

' list all...
For i = 1 To HEAP_Size(Heap.hDataPtrs)/4
If Heap.GetPtr() Then
SetAt( whatever, Heap.DataPtr )
PrintL i, whatever.GetType, whatever.GetName, whatever.Index
Else
PrintL i, "empty slot"
EndIf
Next

WaitKey

End Function


pretty wild and chaotic code to test functionalities - but i like that syntax...

[ErosOlmi]

Rene,

regarding you Bug post here: http://www.thinbasic.com/community/project.php?issueid=475&filter=all#note2766
Please find here enclosed an updated thinCore.dll that should solve the problem.
I think I missed a variable option while extending a new type from a base type.

Let me know if it works. If yes I will tomorrow publish a 1.9.14.0 version, there are too much changes done and I would like others to be able to align to your examples without the need to jump here and there to get latest Core version.
Eros

[ReneMiner]

at first sight it seems to leave the statics of types below untouched- happy about that, but more extensive testing tomorrow - i'll get up early and will test all day :D

[ErosOlmi]

Take your time.
Tomorrow I will have time only late evening.

Ciao
Eros

[ReneMiner]

the stuff i tried yesterday runs now pretty well ( not just that testscript from support ).

At the moment i'm experimenting with some different kinds of data ( as straight fixed-element-size arrays and also arrays where each member can be a different extension of the same basetype )
To get both going i use one more Type for the management: The very base-type to all different kinds of storage now takes care for enumerating types & names so they are globally all the same -none needs to be stored twice- all further extensions have access to the enumerated data - but all extensions of the management have an own list of dataptrs thats pointer is stored in some static of the type.

instead of a picture:



Type Organizer ' this is the very basetype
ID As Long
Static DataPtr As DWord ' additional Function-Result in many cases

Static hAllTypes As DWord ' store all typenames at the very basetype
Static hAllNames As DWord ' organized data can get accessed by name

EnumType As Function ' enumerates & stores all type-names
EnumName As Function ' enumerates & stores all "user-data-names"
End Type
'...usually there won't be anything dimensioned as Organizer
' (except maybe to request the pointer to a name or type)

Type array_at_Heap Extends Organizer
Static hDataPtrs As DWord
Static hDataTypes As DWord
Static hDataBounds As Dword
Create As Function
'...
End Type
'...
Type Organized_Heap Extends Organizer
Static hDataPtrs As DWord ' stores a list of pointers, ID tells which is meant
Create As Function
'...
End Type


Its quite a few kB and pretty undone by now and i just want to give you the idea what's possible already. It's like each type of "organized memory" has its own list of members - but not every member is of the same type.

As mentioned already i have two types of data currently, those straight arrays (even if just consist of 1 element) that don't contain any information for the organizer but just user-data and the other where each element gets a name & index. For the second type is simple- it needs only to store a pointer, the other information is contained in the data. For fixed-element-size-arrays (they are dynamic in element-count though) it's a little more complicated - there the organizer-extension will not just contain an array of dataptrs but one more that contains the type-name-ptrs, another one that shall hold ptrs to some information about dimensions for each array etc. so all static members of "array_At_Heap" are like an extension of the stored data:

Each data gets an index (ID). The .ID is the only real variable (Long) the organizer consists of. Anything else is just statics & functions.
This .ID tells the organizers extensions at which position to find the information like DataPtr, TypeName, Dimensions in those heaps theirs pointers are stored in the organizers statics. Even if ID is a part of the organizer-structure it gets assigned/used by the various possible extensions of the organizer only.

small example


Function array_At_Heap.doSomething()

' assume Me.hDataPtrs is a pointer to some dword-array at heap
' and we are inside some organizer-extension-function for arrays

Local myPtr(Me.ID) As Dword At Me.hDataPtrs
' at myPtr(Me.ID) is some array of some type with certain boundarys stored
Local myType(Me.ID) As Dword At Me.hDataTypes
' here we find a UNIQUE pointer where we can read out a type-name
' unique in that matter that this pointer is the same to all of this type,
' this allows to compare or scan for this pointer instead for the string

Local myDims(Me.ID) As Dword At Me.hDataBounds
' this pointer tells if <> 0 multidimensional and what boundaries the array has been setup to
' ... that easy

Local data Like Heap_Get(myType(Me.ID)) At 0
Local lDims(Heap_Size(myDims(Me.ID))/SizeOf(Dimensions)) As Dimensions At myDims(Me.ID)
For x = lDims(1).LoBound To lDims(1).HiBound
For y = lDims(2).LoBound To lDims(2).HiBound '... "unlimited" dimensions planned...
SetAt( data, Me.ElementPtr(x,y) )
'...


so i can store for example an array of whatever - the organizer will give it an ID and create some "slot" for each information (ptr, type, bounds) - the user-data stays untouched and does not need to be "contaminated with foreign data" - so to say the organizer-type "extends" the data it organizes.

Enough for the moment, hope some of you discover the potential in statics that can hold individual information for all members of a group... and especially the new Array Scan Ptr- option allows to search through the scattered data as if it were nicely ordered in one place.

i need some more coffee...

[ReneMiner]

what am i doing wrong here on Array Scan ?



Uses "console"

' try both, the normal way...
String test1 = MKDWD$(123)
String test2 = MKDWD$(321)

DWord hPtr = HEAP_AllocByStr( test1 & test2 & test1 & test2 & test1 & test2 & test1 & test2)

Dim vPtr(8) As DWord At hPtr
DWord toFind = 123
Long lPos, Index

PrintL "normal scan..."
Do
lPos = Array Scan vPtr(Index+1), Byte(1,4), = toFind

If lPos Then
Index += lPos
PrintL "found", index

EndIf
Loop While lPos

' output i await is found 1, found 3, found 5, found 7...
PrintL "key to continue"

WaitKey
HEAP_Free(hPtr)


' some data to scan for:
'test1 = MKDWD$(123,321)
'test2 = MKDWD$(321,123)

' arrange it in an array
hPtr = HEAP_AllocByStr( MKDWD$( HEAP_AllocByStr(test1), _
HEAP_AllocByStr(test2), _
HEAP_AllocByStr(test1), _
HEAP_AllocByStr(test2), _
HEAP_AllocByStr(test1), _
HEAP_AllocByStr(test2), _
HEAP_AllocByStr(test1), _
HEAP_AllocByStr(test2) _
) )

index = 0

ReDim vPtr(8) At hPtr

PrintL $CRLF & "ptr scan"

Do
lPos = Array Scan vPtr(Index+1) Ptr, Byte(1,4), = MkDwd$(toFind)

If lPos Then
Index += lPos
PrintL "found", index

EndIf

Loop While lPos
' output i await is found 1, found 3, found 5, found 7...

PrintL "key to end"
WaitKey

[ReneMiner]

always new ideas but see above first...


my current idea is about Array Sort this time, it needs a few steps to realize:

Array Sort for standard UDTs alike



Type t_Type
X as Long
S as String
End Type

Dim myArray(123) as t_Type

Array Sort myArray([StartIndex]) [For nElements][,{Ascend | Descend}][, AsFiles] [,Udt_ElementByte( myArray.X)[,Long] ]

Array Sort myArray([StartIndex]) [For nElements][,{Ascend | Descend}][, AsFiles] [,Udt_ElementByte( myArray.S)[,String] ]


If we can sort udts by a certain property than we could think about sorting theirs Pointers and add some Ptr/Heap_Ptr-option...


And another small one:



Array Swap member1, member2

[ErosOlmi]

what am i doing wrong here on Array Scan ?



Uses "console"

' try both, the normal way...
String test1 = MKDWD$(123)
String test2 = MKDWD$(321)

DWord hPtr = HEAP_AllocByStr( test1 & test2 & test1 & test2 & test1 & test2 & test1 & test2)

Dim vPtr(8) As DWord At hPtr
DWord toFind = 123
Long lPos, Index

PrintL "normal scan..."
Do
lPos = Array Scan vPtr(Index+1), Byte(1,4), = toFind

If lPos Then
Index += lPos
PrintL "found", index

EndIf
Loop While lPos

' output i await is found 1, found 3, found 5, found 7...
PrintL "key to continue"

WaitKey
HEAP_Free(hPtr)


' some data to scan for:
'test1 = MKDWD$(123,321)
'test2 = MKDWD$(321,123)

' arrange it in an array
hPtr = HEAP_AllocByStr( MKDWD$( HEAP_AllocByStr(test1), _
HEAP_AllocByStr(test2), _
HEAP_AllocByStr(test1), _
HEAP_AllocByStr(test2), _
HEAP_AllocByStr(test1), _
HEAP_AllocByStr(test2), _
HEAP_AllocByStr(test1), _
HEAP_AllocByStr(test2) _
) )

index = 0

ReDim vPtr(8) At hPtr

PrintL $CRLF & "ptr scan"

Do
lPos = Array Scan vPtr(Index+1) Ptr, Byte(1,4), = MkDwd$(toFind)

If lPos Then
Index += lPos
PrintL "found", index

EndIf

Loop While lPos
' output i await is found 1, found 3, found 5, found 7...

PrintL "key to end"
WaitKey




You are doing nothing wrong.
I did something wrong: I forgot that ARRAY SCAN ...returns position relative to starting scan position.
Instead I was returning absolute position when using ARRAYS SCAN ... PTR ...

Please find here attached an updated thinCore.dll version.
As usual, just unzip into \thinBasic\ directory replacing your current one.
Let me know if it works

Ciao
Eros

[ReneMiner]

perfect :D

[ReneMiner]

working on any type of fixed size array



#MinVersion 1.9.11.0

Function Array_Load(ByVal sFilename As String, _
ByRef a() As Any _
) As Long


ReDim a(1)

Local lSize As Long = SizeOf(a(1))
Local sData As String = Load_File(sFilename)

If StrPtrLen(StrPtr(sData)) = 0 Then Return 0

ReDim a(StrPtrLen(StrPtr(sData))/lSize)

Memory_Set(VarPtr(a(1)), sData )
Function = UBound(a)

End Function


Function Array_Save(ByVal sFilename As String, _
ByRef a() As Any, _
Optional ByVal FirstElementIndex As Long, _
ByVal numElements As Long _
) As Boolean


If UBound(a) < 1 Then Return FALSE

Local lSize As Long = SizeOf(a(1))

firstElementIndex = MinMax(firstElementIndex, 1, UBound(a) )

If numElements < 1 Then numElements = UBound(a)

numElements = MinMax(numElements, 1, UBound(a) + 1 - FirstElementIndex)

Function = ( Save_File(sFilename, Memory_Get(VarPtr(a(FirstElementIndex)), numElements * lSize)) <> 0 )

End Function


' -------------------------------------------------------------
' test

Uses "console"

Type t_myType
A As Long
B As Byte
C As Double
D As String * 8
End Type

$Filename = APP_ScriptPath & "test.dat"

Dim foo(3) As t_myType
Dim i As Long
' fill in some data
For i = 1 To UBound(foo)
foo(i).a = i * 123
foo(i).b = i
foo(i).c = i * 1.23
foo(i).d = "foo(" & TStr$(i) & ")"
Next

If Not Array_Save($Filename, foo ) Then
PrintL "oops- did not work..."
Else
PrintL "data saved"
' kill data:
ReDim foo(1)
PrintL "memory erased now"

If Not Array_Load($Filename, foo ) Then
PrintL "damn, error on loading!"
Else
PrintL "seems it loaded, let's check data"

For i = 1 To UBound(foo)
PrintL foo(i).d & " :", foo(i).A, foo(i).B, foo(i).c
Next
EndIf
EndIf

WaitKey


side product of some thoughts only...
Petr would name those Array ToFile/FromFile probably ;)

[Petr Schreiber]

Hi Rene,

I was thinking about it and Save/Load is okay for me :)


Petr

[Charles Pegge]

In Oxygen, using string overlays:

string s
GetFile "Vertex.b",s
float fl at (strptr s)

'fl[..] is now a dynamic float array


PutFile "Vertex.b",s

[ErosOlmi]

Exactly the same in ThinBASIC:


'---Load a string from a file. It is supposed file contains
'---binary representation of a sequence of doubles (8 bytes each)
String s = Load_File(APP_SourcePath & "FileOfDoubleBinaryNumbers.txt")
'---Create a virtual variable d (virtual because it uses the same memory area
'---of another variable, in this case string s
Double d(Len(s) / SizeOf(Double)) At StrPtr(s)


'---d is now an array of double
'---Because d is dimensioned using the same memory area of another
'---variable, it cannot be re-dimmed but just used


'---Save back s to file. If d() elements have been changed,
'---those changes will be reflected to string s
Save_File(APP_SourcePath & "FileOfDoubleBinaryNumbers.txt", s)




Problem is when you have an array of dynamic string or arrays of pointers to memory areas and you want to save/load from file.
In this case you need to write your own procedure because dynamically allocated memory areas/strings must be re-allocated at run-time.

[ReneMiner]

it was just an idea and of course it would not make sense to save array-elemtents that contain handles, string- or other memory-pointers.
it's meant for "simple data" only which is usually stored in a 1-dimensional array with fixed sized elements (as color-palettes, vertex-lists etc.)

[ErosOlmi]

As usual, yours are always very interesting ideas and quite sure I will develop your request because I think it is general purpose and useful.
Just discussing on how this can be done and what cases it can be applied.
I think the only limitation is when arrays has some dynamic allocated data but in all other cases, even UDT with no dynamic data inside.

I think we can think more general and think to object (arrays, UDT, ...) serialization: http://en.wikipedia.org/wiki/Serialization

[ReneMiner]

it was not a request Eros, then i would have posted into support.

Currently some other Array-related stuff storming through my brains... a tiny little testscript to try out associative arrays - what i'm currently playing with -
...script removed/ improved below-

[ReneMiner]

This to decode CBMSG - as far as it is known. 200 have a name - a and few are occupied twice




#MINVERSION 1.9.15.0

Type t_associative_Array

pKeys As DWord
pBuckets As DWord

AddElement As Function
Free As Function
GetUBound As Function
GetBucket As Function
GetPtr As Function
End Type

Function t_associative_Array.AddElement(ByVal key As String, _
ByVal bucket As String _
) As Long

If HEAP_Size(Me.pKeys) Then
DWord lKey(HEAP_Size(Me.pKeys)/4) At Me.pKeys
If Array Scan lKey Ptr, = key Then
' key not available
Return 0
EndIf
EndIf

Me.pKeys = HEAP_ReAllocByStr( Me.pKeys, HEAP_Get(Me.pKeys) & MKDWD$(HEAP_AllocByStr(key)) )
Me.pBuckets = HEAP_ReAllocByStr( Me.pBuckets, HEAP_Get(Me.pBuckets) & MKDWD$(HEAP_AllocByStr(bucket)) )

Function = HEAP_Size(Me.pKeys)/4

End Function


Function t_associative_Array.Free() As Long

Local i As Long

If HEAP_Size(Me.pKeys) >= 4 Then

DWord lKey(HEAP_Size(Me.pKeys)/4) At Me.pKeys
DWord lBucket(UBound(lKey)) At Me.pBuckets

For i = 1 To UBound(lKey)
HEAP_Free( lKey(i), lBucket(i) )
Next

HEAP_Free(Me.pKeys, Me.pBuckets)

EndIf

Function = 0
End Function

Function t_associative_Array.GetUbound() As Long

Function = HEAP_Size(Me.pKeys)/4

End Function

Function t_associative_Array.GetBucket(ByVal key As String) As String

' returns stored data

Local lPos As Long

If HEAP_Size(Me.pKeys) >= 4 Then

DWord lKey(HEAP_Size(Me.pKeys)/4) At Me.pKeys
DWord lBucket(UBound(lKey)) At Me.pBuckets

lPos = Array Scan lKey Ptr, = key
EndIf

If lPos Then Function = HEAP_Get(lBucket(lPos))

End Function

Function t_associative_Array.GetPtr(ByVal key As String) As DWord

' returns pointer of stored data

Local lPos As Long

If HEAP_Size(Me.pKeys) >= 4 Then

DWord lKey(HEAP_Size(Me.pKeys)/4) At Me.pKeys

lPos = Array Scan lKey Ptr, = key

If lPos Then
DWord lBucket(lPos) At Me.pBuckets
Function = lBucket(lPos)
EndIf
EndIf



End Function


' --------------------------------------------
' test

Uses "console" , "UI"


Dim cbMessage As t_associative_Array


cbMessage.AddElement(%WM_ACTIVATE, "%WM_ACTIVATE")
cbMessage.AddElement(%WM_ACTIVATEAPP, "%WM_ACTIVATEAPP")
cbMessage.AddElement(%WM_AFXFIRST, "%WM_AFXFIRST")
cbMessage.AddElement(%WM_AFXLAST, "%WM_AFXLAST")
cbMessage.AddElement(%WM_APP, "%WM_APP")
cbMessage.AddElement(%WM_APPCOMMAND, "%WM_APPCOMMAND")
cbMessage.AddElement(%WM_ASKCBFORMATNAME, "%WM_ASKCBFORMATNAME")
cbMessage.AddElement(%WM_CANCELJOURNAL, "%WM_CANCELJOURNAL")
cbMessage.AddElement(%WM_CANCELMODE, "%WM_CANCELMODE")
cbMessage.AddElement(%WM_CAPTURECHANGED, "%WM_CAPTURECHANGED")
cbMessage.AddElement(%WM_CHANGECBCHAIN, "%WM_CHANGECBCHAIN")
cbMessage.AddElement(%WM_CHANGEUISTATE, "%WM_CHANGEUISTATE")
cbMessage.AddElement(%WM_CHAR, "%WM_CHAR")
cbMessage.AddElement(%WM_CHARTOITEM, "%WM_CHARTOITEM")
cbMessage.AddElement(%WM_CHILDACTIVATE, "%WM_CHILDACTIVATE")
cbMessage.AddElement(%WM_CLEAR, "%WM_CLEAR")
cbMessage.AddElement(%WM_CLOSE, "%WM_CLOSE")
cbMessage.AddElement(%WM_COMMAND, "%WM_COMMAND")
cbMessage.AddElement(%WM_COMMNOTIFY, "%WM_COMMNOTIFY")
cbMessage.AddElement(%WM_COMPACTING, "%WM_COMPACTING")
cbMessage.AddElement(%WM_COMPAREITEM, "%WM_COMPAREITEM")
cbMessage.AddElement(%WM_CONTEXTMENU, "%WM_CONTEXTMENU")
cbMessage.AddElement(%WM_COPY, "%WM_COPY")
cbMessage.AddElement(%WM_COPYDATA, "%WM_COPYDATA")
cbMessage.AddElement(%WM_CREATE, "%WM_CREATE")
cbMessage.AddElement(%WM_CTLCOLORBTN, "%WM_CTLCOLORBTN")
cbMessage.AddElement(%WM_CTLCOLORDLG, "%WM_CTLCOLORDLG")
cbMessage.AddElement(%WM_CTLCOLOREDIT, "%WM_CTLCOLOREDIT")
cbMessage.AddElement(%WM_CTLCOLORLISTBOX, "%WM_CTLCOLORLISTBOX")
cbMessage.AddElement(%WM_CTLCOLORMSGBOX, "%WM_CTLCOLORMSGBOX")
cbMessage.AddElement(%WM_CTLCOLORSCROLLBAR, "%WM_CTLCOLORSCROLLBAR")
cbMessage.AddElement(%WM_CTLCOLORSTATIC, "%WM_CTLCOLORSTATIC")
cbMessage.AddElement(%WM_CUT, "%WM_CUT")
cbMessage.AddElement(%WM_DEADCHAR, "%WM_DEADCHAR")
cbMessage.AddElement(%WM_DELETEITEM, "%WM_DELETEITEM")
cbMessage.AddElement(%WM_DESTROY, "%WM_DESTROY")
cbMessage.AddElement(%WM_DESTROYCLIPBOARD, "%WM_DESTROYCLIPBOARD")
cbMessage.AddElement(%WM_DEVICECHANGE, "%WM_DEVICECHANGE")
cbMessage.AddElement(%WM_DEVMODECHANGE, "%WM_DEVMODECHANGE")
cbMessage.AddElement(%WM_DISPLAYCHANGE, "%WM_DISPLAYCHANGE")
cbMessage.AddElement(%WM_DRAWCLIPBOARD, "%WM_DRAWCLIPBOARD")
cbMessage.AddElement(%WM_DRAWITEM, "%WM_DRAWITEM")
cbMessage.AddElement(%WM_DROPFILES, "%WM_DROPFILES")
cbMessage.AddElement(%WM_ENABLE, "%WM_ENABLE")
cbMessage.AddElement(%WM_ENDSESSION, "%WM_ENDSESSION")
cbMessage.AddElement(%WM_ENTERIDLE, "%WM_ENTERIDLE")
cbMessage.AddElement(%WM_ENTERMENULOOP, "%WM_ENTERMENULOOP")
cbMessage.AddElement(%WM_ENTERSIZEMOVE, "%WM_ENTERSIZEMOVE")
cbMessage.AddElement(%WM_ERASEBKGND, "%WM_ERASEBKGND")
cbMessage.AddElement(%WM_EXITMENULOOP, "%WM_EXITMENULOOP")
cbMessage.AddElement(%WM_EXITSIZEMOVE, "%WM_EXITSIZEMOVE")
cbMessage.AddElement(%WM_FONTCHANGE, "%WM_FONTCHANGE")
cbMessage.AddElement(%WM_GETDLGCODE, "%WM_GETDLGCODE")
cbMessage.AddElement(%WM_GETFONT, "%WM_GETFONT")
cbMessage.AddElement(%WM_GETHOTKEY, "%WM_GETHOTKEY")
cbMessage.AddElement(%WM_GETICON, "%WM_GETICON")
cbMessage.AddElement(%WM_GETMINMAXINFO, "%WM_GETMINMAXINFO")
cbMessage.AddElement(%WM_GETOBJECT, "%WM_GETOBJECT")
cbMessage.AddElement(%WM_GETTEXT, "%WM_GETTEXT")
cbMessage.AddElement(%WM_GETTEXTLENGTH, "%WM_GETTEXTLENGTH")
cbMessage.AddElement(%WM_HANDHELDFIRST, "%WM_HANDHELDFIRST")
cbMessage.AddElement(%WM_HANDHELDLAST, "%WM_HANDHELDLAST")
cbMessage.AddElement(%WM_HELP, "%WM_HELP")
cbMessage.AddElement(%WM_HOTKEY, "%WM_HOTKEY")
cbMessage.AddElement(%WM_HSCROLL, "%WM_HSCROLL")
cbMessage.AddElement(%WM_HSCROLLCLIPBOARD, "%WM_HSCROLLCLIPBOARD")
cbMessage.AddElement(%WM_ICONERASEBKGND, "%WM_ICONERASEBKGND")
cbMessage.AddElement(%WM_IDLE, "%WM_IDLE, %WM_NULL")
cbMessage.AddElement(%WM_INITDIALOG, "%WM_INITDIALOG")
cbMessage.AddElement(%WM_INITMENU, "%WM_INITMENU")
cbMessage.AddElement(%WM_INITMENUPOPUP, "%WM_INITMENUPOPUP")
cbMessage.AddElement(%WM_INPUT, "%WM_INPUT")
cbMessage.AddElement(%WM_INPUTLANGCHANGE, "%WM_INPUTLANGCHANGE")
cbMessage.AddElement(%WM_INPUTLANGCHANGEREQUEST, "%WM_INPUTLANGCHANGEREQUEST")
cbMessage.AddElement(%WM_KEYDOWN, "%WM_KEYDOWN, %WM_KEYFIRST")
cbMessage.AddElement(%WM_KEYLAST, "%WM_KEYLAST, %WM_UNICHAR")
cbMessage.AddElement(%WM_KEYUP, "%WM_KEYUP")
cbMessage.AddElement(%WM_KILLFOCUS, "%WM_KILLFOCUS")
cbMessage.AddElement(%WM_LBUTTONDBLCLK, "%WM_LBUTTONDBLCLK")
cbMessage.AddElement(%WM_LBUTTONDOWN, "%WM_LBUTTONDOWN")
cbMessage.AddElement(%WM_LBUTTONUP, "%WM_LBUTTONUP")
cbMessage.AddElement(%WM_MBUTTONDBLCLK, "%WM_MBUTTONDBLCLK")
cbMessage.AddElement(%WM_MBUTTONDOWN, "%WM_MBUTTONDOWN")
cbMessage.AddElement(%WM_MBUTTONUP, "%WM_MBUTTONUP")
cbMessage.AddElement(%WM_MDIACTIVATE, "%WM_MDIACTIVATE")
cbMessage.AddElement(%WM_MDICASCADE, "%WM_MDICASCADE")
cbMessage.AddElement(%WM_MDICREATE, "%WM_MDICREATE")
cbMessage.AddElement(%WM_MDIDESTROY, "%WM_MDIDESTROY")
cbMessage.AddElement(%WM_MDIGETACTIVE, "%WM_MDIGETACTIVE")
cbMessage.AddElement(%WM_MDIICONARRANGE, "%WM_MDIICONARRANGE")
cbMessage.AddElement(%WM_MDIMAXIMIZE, "%WM_MDIMAXIMIZE")
cbMessage.AddElement(%WM_MDINEXT, "%WM_MDINEXT")
cbMessage.AddElement(%WM_MDIREFRESHMENU, "%WM_MDIREFRESHMENU")
cbMessage.AddElement(%WM_MDIRESTORE, "%WM_MDIRESTORE")
cbMessage.AddElement(%WM_MDISETMENU, "%WM_MDISETMENU")
cbMessage.AddElement(%WM_MDITILE, "%WM_MDITILE")
cbMessage.AddElement(%WM_MEASUREITEM, "%WM_MEASUREITEM")
cbMessage.AddElement(%WM_MENUCHAR, "%WM_MENUCHAR")
cbMessage.AddElement(%WM_MENUCOMMAND, "%WM_MENUCOMMAND")
cbMessage.AddElement(%WM_MENUDRAG, "%WM_MENUDRAG")
cbMessage.AddElement(%WM_MENUGETOBJECT, "%WM_MENUGETOBJECT")
cbMessage.AddElement(%WM_MENURBUTTONUP, "%WM_MENURBUTTONUP")
cbMessage.AddElement(%WM_MENUSELECT, "%WM_MENUSELECT")
cbMessage.AddElement(%WM_MOUSEACTIVATE, "%WM_MOUSEACTIVATE")
cbMessage.AddElement(%WM_MOUSEFIRST, "%WM_MOUSEFIRST, %WM_MOUSEMOVE")
cbMessage.AddElement(%WM_MOUSEHOVER, "%WM_MOUSEHOVER")
cbMessage.AddElement(%WM_MOUSELAST, "%WM_MOUSELAST")
cbMessage.AddElement(%WM_MOUSELEAVE, "%WM_MOUSELEAVE")
cbMessage.AddElement(%WM_MOUSEWHEEL, "%WM_MOUSEWHEEL")
cbMessage.AddElement(%WM_MOVE, "%WM_MOVE")
cbMessage.AddElement(%WM_MOVING, "%WM_MOVING")
cbMessage.AddElement(%WM_NCACTIVATE, "%WM_NCACTIVATE")
cbMessage.AddElement(%WM_NCCALCSIZE, "%WM_NCCALCSIZE")
cbMessage.AddElement(%WM_NCCREATE, "%WM_NCCREATE")
cbMessage.AddElement(%WM_NCDESTROY, "%WM_NCDESTROY")
cbMessage.AddElement(%WM_NCHITTEST, "%WM_NCHITTEST")
cbMessage.AddElement(%WM_NCLBUTTONDBLCLK, "%WM_NCLBUTTONDBLCLK")
cbMessage.AddElement(%WM_NCLBUTTONDOWN, "%WM_NCLBUTTONDOWN")
cbMessage.AddElement(%WM_NCLBUTTONUP, "%WM_NCLBUTTONUP")
cbMessage.AddElement(%WM_NCMBUTTONDBLCLK, "%WM_NCMBUTTONDBLCLK")
cbMessage.AddElement(%WM_NCMBUTTONDOWN, "%WM_NCMBUTTONDOWN")
cbMessage.AddElement(%WM_NCMBUTTONUP, "%WM_NCMBUTTONUP")
cbMessage.AddElement(%WM_NCMOUSEMOVE, "%WM_NCMOUSEMOVE")
cbMessage.AddElement(%WM_NCPAINT, "%WM_NCPAINT")
cbMessage.AddElement(%WM_NCRBUTTONDBLCLK, "%WM_NCRBUTTONDBLCLK")
cbMessage.AddElement(%WM_NCRBUTTONDOWN, "%WM_NCRBUTTONDOWN")
cbMessage.AddElement(%WM_NCRBUTTONUP, "%WM_NCRBUTTONUP")
cbMessage.AddElement(%WM_NCXBUTTONDBLCLK, "%WM_NCXBUTTONDBLCLK")
cbMessage.AddElement(%WM_NCXBUTTONDOWN, "%WM_NCXBUTTONDOWN")
cbMessage.AddElement(%WM_NCXBUTTONUP, "%WM_NCXBUTTONUP")
cbMessage.AddElement(%WM_NEXTDLGCTL, "%WM_NEXTDLGCTL")
cbMessage.AddElement(%WM_NOTIFY, "%WM_NOTIFY")
cbMessage.AddElement(%WM_NOTIFYFORMAT, "%WM_NOTIFYFORMAT")
cbMessage.AddElement(%WM_PAINT, "%WM_PAINT")
cbMessage.AddElement(%WM_PAINTCLIPBOARD, "%WM_PAINTCLIPBOARD")
cbMessage.AddElement(%WM_PAINTICON, "%WM_PAINTICON")
cbMessage.AddElement(%WM_PALETTECHANGED, "%WM_PALETTECHANGED")
cbMessage.AddElement(%WM_PALETTEISCHANGING, "%WM_PALETTEISCHANGING")
cbMessage.AddElement(%WM_PARENTNOTIFY, "%WM_PARENTNOTIFY")
cbMessage.AddElement(%WM_PASTE, "%WM_PASTE")
cbMessage.AddElement(%WM_PENWINFIRST, "%WM_PENWINFIRST")
cbMessage.AddElement(%WM_PENWINLAST, "%WM_PENWINLAST")
cbMessage.AddElement(%WM_POWER, "%WM_POWER")
cbMessage.AddElement(%WM_POWERBROADCAST, "%WM_POWERBROADCAST")
cbMessage.AddElement(%WM_PRINT, "%WM_PRINT")
cbMessage.AddElement(%WM_PRINTCLIENT, "%WM_PRINTCLIENT")
cbMessage.AddElement(%WM_QUERYDRAGICON, "%WM_QUERYDRAGICON")
cbMessage.AddElement(%WM_QUERYENDSESSION, "%WM_QUERYENDSESSION")
cbMessage.AddElement(%WM_QUERYNEWPALETTE, "%WM_QUERYNEWPALETTE")
cbMessage.AddElement(%WM_QUERYOPEN, "%WM_QUERYOPEN")
cbMessage.AddElement(%WM_QUERYUISTATE, "%WM_QUERYUISTATE")
cbMessage.AddElement(%WM_QUEUESYNC, "%WM_QUEUESYNC")
cbMessage.AddElement(%WM_QUIT, "%WM_QUIT")
cbMessage.AddElement(%WM_RBUTTONDBLCLK, "%WM_RBUTTONDBLCLK")
cbMessage.AddElement(%WM_RBUTTONDOWN, "%WM_RBUTTONDOWN")
cbMessage.AddElement(%WM_RBUTTONUP, "%WM_RBUTTONUP")
cbMessage.AddElement(%WM_RENDERALLFORMATS, "%WM_RENDERALLFORMATS")
cbMessage.AddElement(%WM_RENDERFORMAT, "%WM_RENDERFORMAT")
cbMessage.AddElement(%WM_SETCURSOR, "%WM_SETCURSOR")
cbMessage.AddElement(%WM_SETFOCUS, "%WM_SETFOCUS")
cbMessage.AddElement(%WM_SETFONT, "%WM_SETFONT")
cbMessage.AddElement(%WM_SETHOTKEY, "%WM_SETHOTKEY")
cbMessage.AddElement(%WM_SETICON, "%WM_SETICON")
cbMessage.AddElement(%WM_SETREDRAW, "%WM_SETREDRAW")
cbMessage.AddElement(%WM_SETTEXT, "%WM_SETTEXT")
cbMessage.AddElement(%WM_SETTINGCHANGE, "%WM_SETTINGCHANGE, %WM_WININICHANGE")
cbMessage.AddElement(%WM_SHOWWINDOW, "%WM_SHOWWINDOW")
cbMessage.AddElement(%WM_SIZE, "%WM_SIZE")
cbMessage.AddElement(%WM_SIZECLIPBOARD, "%WM_SIZECLIPBOARD")
cbMessage.AddElement(%WM_SIZING, "%WM_SIZING")
cbMessage.AddElement(%WM_SPOOLERSTATUS, "%WM_SPOOLERSTATUS")
cbMessage.AddElement(%WM_STYLECHANGED, "%WM_STYLECHANGED")
cbMessage.AddElement(%WM_STYLECHANGING, "%WM_STYLECHANGING")
cbMessage.AddElement(%WM_SYNCPAINT, "%WM_SYNCPAINT")
cbMessage.AddElement(%WM_SYSCHAR, "%WM_SYSCHAR")
cbMessage.AddElement(%WM_SYSCOLORCHANGE, "%WM_SYSCOLORCHANGE")
cbMessage.AddElement(%WM_SYSCOMMAND, "%WM_SYSCOMMAND")
cbMessage.AddElement(%WM_SYSDEADCHAR, "%WM_SYSDEADCHAR")
cbMessage.AddElement(%WM_SYSKEYDOWN, "%WM_SYSKEYDOWN")
cbMessage.AddElement(%WM_SYSKEYUP, "%WM_SYSKEYUP")
cbMessage.AddElement(%WM_TABLET_FIRST, "%WM_TABLET_FIRST")
cbMessage.AddElement(%WM_TABLET_LAST, "%WM_TABLET_LAST")
cbMessage.AddElement(%WM_TCARD, "%WM_TCARD")
cbMessage.AddElement(%WM_THEMECHANGED, "%WM_THEMECHANGED")
cbMessage.AddElement(%WM_TIMECHANGE, "%WM_TIMECHANGE")
cbMessage.AddElement(%WM_TIMER, "%WM_TIMER")
cbMessage.AddElement(%WM_UNDO, "%WM_UNDO")
cbMessage.AddElement(%WM_UNINITMENUPOPUP, "%WM_UNINITMENUPOPUP")
cbMessage.AddElement(%WM_UPDATEUISTATE, "%WM_UPDATEUISTATE")
cbMessage.AddElement(%WM_USER, "%WM_USER")
cbMessage.AddElement(%WM_USERCHANGED, "%WM_USERCHANGED")
cbMessage.AddElement(%WM_VKEYTOITEM, "%WM_VKEYTOITEM")
cbMessage.AddElement(%WM_VSCROLL, "%WM_VSCROLL")
cbMessage.AddElement(%WM_VSCROLLCLIPBOARD, "%WM_VSCROLLCLIPBOARD")
cbMessage.AddElement(%WM_WINDOWPOSCHANGED, "%WM_WINDOWPOSCHANGED")
cbMessage.AddElement(%WM_WINDOWPOSCHANGING, "%WM_WINDOWPOSCHANGING")
cbMessage.AddElement(%WM_WTSSESSION_CHANGE, "%WM_WTSSESSION_CHANGE")
cbMessage.AddElement(%WM_XBUTTONDBLCLK, "%WM_XBUTTONDBLCLK")
cbMessage.AddElement(%WM_XBUTTONDOWN, "%WM_XBUTTONDOWN")
cbMessage.AddElement(%WM_XBUTTONUP, "%WM_XBUTTONUP")


Function TBMain()

Dim hDlg As Long

Dialog New Pixels, 0, "look - a window!", _
0, 0, 640, 480, _
%DS_CENTER | %WS_OVERLAPPEDWINDOW | %WS_CAPTION | %WS_THICKFRAME, _
%WS_EX_CLIENTEDGE _
To hDlg

Dialog Show Modal hDlg, Call cb_Main

PrintL "key to end"
WaitKey

End Function

CallBack Function cb_Main()

' now what happens?

PrintL "&H" & Hex$(CBMSG, 4), cbMessage.GetBucket(CBMSG)


End Function