+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: Chatting and Socializing (https://qb64phoenix.com/forum/forumdisplay.php?fid=11)
+--- Forum: General Discussion (https://qb64phoenix.com/forum/forumdisplay.php?fid=2)
+--- Thread: Arrays as UDTs (/showthread.php?tid=4442)
RE: Arrays as UDTs - ahenry3068 - 02-03-2026
(02-03-2026, 08:41 PM)Pete Wrote:(02-03-2026, 06:09 PM)SMcNeill Wrote: Ideally, something like this would track string and size both on the back side of the c header.
A format such as: Length of string stored as LONG, then the string stored. Then you just read the first four bytes, get the length, and then know exactly how many bytes to get for the string itself.
The issue is QB64 does NOT null terminate strings. "HELLO" + CHR$(0) + "WORLD" is a perfectly valid QB64 string. In C, that would read as *just* "HELLO" + terminator. The way to bypass that termination character is to count bytes and say, "OH I NEEDS 11 BYTES TO RETURN!!"
Unseen needs to change his structure to store length + string, and not just string alone, so it'd be usable in QB64 without issues.
Speaking of tracking string and length...
Pure QB64 method to pass arrays.
Code: (Select All)Type foo
index As String
array As String
build As String
id As Integer
End Type
Dim z As foo
Concat_Arrays z: Display_Arrays z
Sub Concat_Arrays (z As foo)
While -1
i = i + 1: j = 0
Do
Read a$
If a$ = "eof" Then Exit While
If a$ = "eol" Then Exit Do
z.index = z.index + LTrim$(Str$(i)) + "," + LTrim$(Str$(Len(a$))) + "|" ' Parent and length of string added.
z.array = z.array + a$
j = j + 1
Loop
Wend
End Sub
Sub Display_Arrays (z As foo)
ReDim a(10), Fruits$(10), Veggies$(10), Meats$(10)
Do
Unpack z: If z.id = 0 Then Exit Do
If z.id <> oldid Then a = 0
a = a + 1
Select Case z.id
Case 1: Fruits$(a) = z.build
Case 2: Veggies$(a) = z.build
Case 3: Meats$(a) = z.build
End Select
oldid = z.id
Loop
For i = 1 To UBound(Fruits$)
If Len(Fruits$(i)) Then Print Fruits$(i)
Next
For i = 1 To UBound(Veggies$)
If Len(Veggies$(i)) Then Print Veggies$(i)
Next
For i = 1 To UBound(Meats$)
If Len(Meats$(i)) Then Print Meats$(i)
Next
End Sub
Sub Unpack (z As foo)
Static seed, c
j = InStr(seed, z.index, ","): If j = 0 Then z.id = 0: Exit Sub
z.id = Val(Mid$(z.index, j - 1))
b = Val(Mid$(z.index, j + 1, InStr(Mid$(z.index, j + 1), "|")))
seed = j + 1
z.build = Mid$(z.array, c + 1, b)
c = c + b
End Sub
Data Fruits,Apple,Orange,Pear,Banana,Plum,eol
Data Veggies,Squash,Peas,Green Beans,Carrot,Celery,eol
Data Meats,Steak,Bacon,Chicken,Fish,eol
Data eof
We have other examples in a thread from September: https://qb64phoenix.com/forum/showthread.php?tid=3956
Well, as fun as this is, and I have to go try Unseen's header fixes, I cant see myself duplicating the routine, that gathers the arrays from memory, in every sub they will be needed in. One or two, fine, several, I can't see myself doing that, because it no longer would be a time saver.
Pete
I use a different method in my code here: https://qb64phoenix.com/forum/showthread.php?tid=219&pid=38668#pid38668
RE: Arrays as UDTs - Pete - 02-03-2026
@Unseen Machine
John, unfortunately the changes didn't take.
Code: (Select All)
DECLARE LIBRARY "qb_universal"
FUNCTION Var_New%& ALIAS "QB_New" ()
SUB Var_SetString ALIAS "QB_SetString" (BYVAL h AS _OFFSET, s AS STRING)
SUB Var_SetInt ALIAS "QB_SetInt64" (BYVAL h AS _OFFSET, BYVAL v AS _INTEGER64)
SUB Var_SetDouble ALIAS "QB_SetDouble" (BYVAL h AS _OFFSET, BYVAL v AS DOUBLE)
FUNCTION Var_GetString$ ALIAS "QB_GetString" (BYVAL h AS _OFFSET)
FUNCTION Var_GetStringLength& ALIAS QB_GetStringLength (BYVAL Str AS _OFFSET)
FUNCTION Var_GetInt& ALIAS "QB_GetInt64" (BYVAL h AS _OFFSET)
FUNCTION Var_GetDouble# ALIAS "QB_GetDouble" (BYVAL h AS _OFFSET)
SUB Var_Push ALIAS "QB_Push" (BYVAL parent AS _OFFSET, BYVAL child AS _OFFSET)
FUNCTION Var_Count& ALIAS "QB_Count" (BYVAL h AS _OFFSET)
FUNCTION Var_At%& ALIAS "QB_At" (BYVAL h AS _OFFSET, BYVAL i AS LONG)
SUB Var_Free ALIAS "QB_Free" (BYVAL h AS _OFFSET)
END DECLARECode: (Select All)
#ifndef QB_UNIVERSAL_H
#define QB_UNIVERSAL_H
#include <vector>
#include <string>
#include <cstdint>
extern "C" {
typedef intptr_t QBHandle;
struct QBNode {
std::string s; // STRING
int64_t i64; // _INTEGER64 / LONG / INTEGER
double d; // DOUBLE / SINGLE
intptr_t ptr; // _OFFSET
std::vector<QBNode*> children;
};
// Generic Creator
__declspec(dllexport) QBHandle QB_New() { return (QBHandle)new QBNode(); }
// Setters
__declspec(dllexport) void QB_SetString(QBHandle h, const char* v) { if(h) ((QBNode*)h)->s = v; }
__declspec(dllexport) void QB_SetInt64(QBHandle h, int64_t v) { if(h) ((QBNode*)h)->i64 = v; }
__declspec(dllexport) void QB_SetDouble(QBHandle h, double v) { if(h) ((QBNode*)h)->d = v; }
__declspec(dllexport) void QB_SetOffset(QBHandle h, intptr_t v) { if(h) ((QBNode*)h)->ptr = v; }
// Getters
__declspec(dllexport) const char* QB_GetString(QBHandle h) { return h ? ((QBNode*)h)->s.c_str() : ""; }
__declspec(dllexport) int64_t QB_GetInt64(QBHandle h) { return h ? ((QBNode*)h)->i64 : 0; }
__declspec(dllexport) double QB_GetDouble(QBHandle h) { return h ? ((QBNode*)h)->d : 0.0; }
__declspec(dllexport) intptr_t QB_GetOffset(QBHandle h) { return h ? ((QBNode*)h)->ptr : 0; }
// Vector Logic (The "Whole Hog" part)
__declspec(dllexport) void QB_Push(QBHandle parent, QBHandle child) {
if (parent && child) ((QBNode*)parent)->children.push_back((QBNode*)child);
}
__declspec(dllexport) int QB_Count(QBHandle h) { return h ? (int)((QBNode*)h)->children.size() : 0; }
__declspec(dllexport) QBHandle QB_At(QBHandle h, int i) {
auto* n = (QBNode*)h;
return (n && i >= 0 && i < (int)n->children.size()) ? (QBHandle)n->children[i] : 0;
}
// Deep Garbage Collection
__declspec(dllexport) void QB_Free(QBHandle h) {
if (!h) return;
QBNode* n = (QBNode*)h;
for (auto* c : n->children) QB_Free((QBHandle)c);
delete n;
}
__declspec(dllexport) int QB_GetStringLength(QBHandle h) {
return h ? (int)((QBNode*)h)->s.size() : 0;
}
}
#endifCode: (Select All)
'$Dynamic
'$Include:'qb_universal.bi'
Dim MemSystem As _Offset
MemSystem = Var_New ' Library function.
Dim p As _Offset
Dim fruit$(4), meat$(3)
fruit$(1) = "apple": fruit$(2) = "orange": fruit$(3) = "pear": fruit$(4) = "banana": meat$(1) = "steak": meat$(2) = "chicken": meat$(3) = "bacon"
p = Parent_Node("Fruit123", MemSystem): Child_Node fruit$(), p
p = Parent_Node("Meat", MemSystem): Child_Node meat$(), p
pete MemSystem
Var_Free MemSystem
End
Function Parent_Node%& (Parent As String, MemSystem As _Offset)
Dim a As _Offset
Rem Parent = Parent + Chr$(0) ' C null terminator. <----- Required when a 'Parent' string is sent to a sub or function.
a = Var_New: Var_SetString a, Parent: Var_Push MemSystem, a: Parent_Node = a
End Function
Sub Child_Node (array$(), p As _Offset)
Dim c As _Offset
For i = 1 To UBound(array$)
c = Var_New: Var_SetString c, array$(i): Var_Push p, c
Next
End SubTake the Rem out of the Chr$(0) null terminate statement and it works, but with this line remarked out, as above, I got the exact same overlap results as before. Yes, this header file is the one in the folder the code runs in. I overwrote both the old header and the old bi file and did a copy and paste here. I'm pretty sure I changed them correctly, but if not, let me know.
Pete
RE: Arrays as UDTs - Unseen Machine - 02-03-2026
@Pete DAMNATION! Sorry bro! But heres my declares and the .h as i have em and it works for me using the demo usage i posted.
Code: (Select All)
DECLARE LIBRARY "qb_universal"
FUNCTION Var_New%& ALIAS "QB_New" ()
SUB Var_SetString ALIAS "QB_SetString" (BYVAL h AS _OFFSET, s AS STRING)
SUB Var_SetInt ALIAS "QB_SetInt64" (BYVAL h AS _OFFSET, BYVAL v AS _INTEGER64)
SUB Var_SetDouble ALIAS "QB_SetDouble" (BYVAL h AS _OFFSET, BYVAL v AS DOUBLE)
FUNCTION Var_GetString$ ALIAS "QB_GetString" (BYVAL h AS _OFFSET)
FUNCTION Var_GetInt& ALIAS "QB_GetInt64" (BYVAL h AS _OFFSET)
FUNCTION Var_GetDouble# ALIAS "QB_GetDouble" (BYVAL h AS _OFFSET)
SUB Var_Push ALIAS "QB_Push" (BYVAL parent AS _OFFSET, BYVAL child AS _OFFSET)
FUNCTION Var_Count& ALIAS "QB_Count" (BYVAL h AS _OFFSET)
FUNCTION Var_At%& ALIAS "QB_At" (BYVAL h AS _OFFSET, BYVAL i AS LONG)
SUB Var_Free ALIAS "QB_Free" (BYVAL h AS _OFFSET)
FUNCTION Var_GetStringLength& ALIAS QB_GetStringLength (BYVAL Str AS _OFFSET)
END DECLARE
Code: (Select All)
#ifndef QB_UNIVERSAL_H
#define QB_UNIVERSAL_H
#include <vector>
#include <string>
#include <cstdint>
extern "C" {
typedef intptr_t QBHandle;
struct QBNode {
std::string s; // STRING
int64_t i64; // _INTEGER64 / LONG / INTEGER
double d; // DOUBLE / SINGLE
intptr_t ptr; // _OFFSET
std::vector<QBNode*> children;
};
// Generic Creator
__declspec(dllexport) QBHandle QB_New() { return (QBHandle)new QBNode(); }
// Setters
__declspec(dllexport) void QB_SetString(QBHandle h, const char* v) { if(h) ((QBNode*)h)->s = v; }
__declspec(dllexport) void QB_SetInt64(QBHandle h, int64_t v) { if(h) ((QBNode*)h)->i64 = v; }
__declspec(dllexport) void QB_SetDouble(QBHandle h, double v) { if(h) ((QBNode*)h)->d = v; }
__declspec(dllexport) void QB_SetOffset(QBHandle h, intptr_t v) { if(h) ((QBNode*)h)->ptr = v; }
// Getters
__declspec(dllexport) const char* QB_GetString(QBHandle h) { return h ? ((QBNode*)h)->s.c_str() : ""; }
__declspec(dllexport) int64_t QB_GetInt64(QBHandle h) { return h ? ((QBNode*)h)->i64 : 0; }
__declspec(dllexport) double QB_GetDouble(QBHandle h) { return h ? ((QBNode*)h)->d : 0.0; }
__declspec(dllexport) intptr_t QB_GetOffset(QBHandle h) { return h ? ((QBNode*)h)->ptr : 0; }
// Vector Logic (The "Whole Hog" part)
__declspec(dllexport) void QB_Push(QBHandle parent, QBHandle child) {
if (parent && child) ((QBNode*)parent)->children.push_back((QBNode*)child);
}
__declspec(dllexport) int QB_Count(QBHandle h) { return h ? (int)((QBNode*)h)->children.size() : 0; }
__declspec(dllexport) QBHandle QB_At(QBHandle h, int i) {
auto* n = (QBNode*)h;
return (n && i >= 0 && i < (int)n->children.size()) ? (QBHandle)n->children[i] : 0;
}
__declspec(dllexport) const char* QB_ToTabDelimited(QBHandle sheet) {
if (!sheet) return "";
static std::string buffer; // Static for QB64 return persistence
buffer = "";
QBNode* s = (QBNode*)sheet;
for (auto* row : s->children) {
for (size_t i = 0; i < row->children.size(); ++i) {
buffer += row->children[i]->s;
if (i < row->children.size() - 1) buffer += "\t";
}
buffer += "\n";
}
return buffer.c_str();
}
// Deep Garbage Collection
__declspec(dllexport) void QB_Free(QBHandle h) {
if (!h) return;
QBNode* n = (QBNode*)h;
for (auto* c : n->children) QB_Free((QBHandle)c);
delete n;
}
__declspec(dllexport) int QB_GetStringLength(QBHandle h) {
return h ? (int)((QBNode*)h)->s.size() : 0;
}
}
#endifThanks
Unseen
John
RE: Arrays as UDTs - Unseen Machine - 02-03-2026
Also, in my defence, this library was as a proof of concept not a final "This is how you do it!" @Petr and @a740g and @RhoSigma are way more experienced in this field and hopefully they can take the idea and expand it to work. I think a set of functions that are based on specific formats such as strings, longs and doubles would be better and a cleaner approach rather than the union style it currently has. Whilst in its current form it can effectively remove the need for UDTs entirely i dont think that that style fits the BASIC ethos at all.
Still @Pete I am grateful you gave it a shot and from your headaches I hope we will be able to make a simple system that provides the functionality we are aiming for.
John
p.s I forgot to add the quotes to the alias so maybe thats why it failed!
RE: Arrays as UDTs - Pete - 02-03-2026
@Unseen Machine
John, try this...
Code: (Select All)
'$Dynamic
'$Include:'qb_universal.bi'
Screen _NewImage(800, 600, 32)
' --- DATA INITIALIZATION ---
Dim Shared MenuSystem As _Offset
MenuSystem = Var_New
' Build Edit Menu
Dim EditMenu As _Offset: EditMenu = BuildMenu("&Edit")
AddWordItem EditMenu, "ABCDEFGHIJ" ' <------------------- I flipping flipped them!
AddWordItem EditMenu, "ABCDEFGH"
AddWordItem EditMenu, "ABCDEF"
AddWordItem EditMenu, "ABCD"
AddWordItem EditMenu, "AB"
For i% = 0 To 4
Print Var_GetStringLength(Var_At(EditMenu, i%)), Var_GetString(Var_At(EditMenu, i%))
Next
Sleep
Var_Free EditMenu
System
' --- SUBS AND FUNCTIONS ---
Function BuildMenu%& (Title As String)
Dim m As _Offset: m = Var_New
Var_SetString m, Title
Var_Push MenuSystem, m
BuildMenu = m
End Function
Sub AddWordItem (parent As _Offset, text As String)
Dim n As _Offset: n = Var_New
Var_SetString n, text
Var_Push parent, n
End SubI just flipped the strings so the longer ones come first. See the output, it lists everyone as 10. It only works if the next string is larger or equal in length to the string that came before it. That's the problem.
You can put a text = text + Chr$(0) in your sub and run it again. It will then work as intended. 10-8-6-4-2
In testing, I also added , Var_GetString(Var_At(EditMenu, i%)) to the for/next sub, to also print the strings.
Pete
PS I added the quotes to the alias, no difference.
RE: Arrays as UDTs - Unseen Machine - 02-03-2026
@Pete NO You try this!
Save as QB_Omega.h
Code: (Select All)
#ifndef OMEGA_LINK_H
#define OMEGA_LINK_H
#include <cstdint>
#include <string>
#include <cstring>
#include <algorithm>
extern "C" {
struct Arena {
void* data;
uint64_t* mask;
int64_t capacity;
int64_t type_id;
};
inline Arena* AsA(intptr_t p) { return (Arena*)p; }
intptr_t Omega_Create(int64_t sz, int64_t type) {
Arena* a = new Arena();
a->capacity = sz;
a->type_id = type;
a->mask = new uint64_t[(sz + 63) / 64]();
if (type == 0) a->data = new int32_t[sz]();
if (type == 1) a->data = new double[sz]();
if (type == 2) a->data = new std::string[sz]();
return (intptr_t)a;
}
int64_t Omega_Find(intptr_t a_ptr) {
Arena* a = AsA(a_ptr);
if (!a) return -1;
for (int64_t i = 0; i < (a->capacity + 63) / 64; i++) {
if (a->mask[i] != ~0ULL) {
int64_t bit = __builtin_ctzll(~a->mask[i]);
int64_t res = (i * 64) + bit;
return (res < a->capacity) ? res : -1;
}
}
return -1;
}
void Omega_Grow(intptr_t a_ptr, int64_t new_sz) {
Arena* a = AsA(a_ptr);
if (new_sz <= a->capacity) return;
int64_t old_m_sz = (a->capacity + 63) / 64;
int64_t new_m_sz = (new_sz + 63) / 64;
uint64_t* new_mask = new uint64_t[new_m_sz]();
std::memcpy(new_mask, a->mask, old_m_sz * 8);
delete[] a->mask; a->mask = new_mask;
if (a->type_id == 0) {
int32_t* n = new int32_t[new_sz]();
std::memcpy(n, a->data, a->capacity * 4);
delete[] (int32_t*)a->data; a->data = n;
} else if (a->type_id == 1) {
double* n = new double[new_sz]();
std::memcpy(n, a->data, a->capacity * 8);
delete[] (double*)a->data; a->data = n;
} else if (a->type_id == 2) {
std::string* n = new std::string[new_sz]();
for(int64_t i=0; i<a->capacity; ++i) n[i] = std::move(((std::string*)a->data)[i]);
delete[] (std::string*)a->data; a->data = n;
}
a->capacity = new_sz;
}
void Omega_SetL(intptr_t a, int64_t i, int32_t v) { ((int32_t*)AsA(a)->data)[i] = v; AsA(a)->mask[i/64] |= (1ULL << (i%64)); }
void Omega_SetD(intptr_t a, int64_t i, double v) { ((double*)AsA(a)->data)[i] = v; AsA(a)->mask[i/64] |= (1ULL << (i%64)); }
void Omega_SetS(intptr_t a, int64_t i, const char* v) { ((std::string*)AsA(a)->data)[i] = v; AsA(a)->mask[i/64] |= (1ULL << (i%64)); }
int32_t Omega_GetL(intptr_t a, int64_t i) { return ((int32_t*)AsA(a)->data)[i]; }
double Omega_GetD(intptr_t a, int64_t i) { return ((double*)AsA(a)->data)[i]; }
const char* Omega_GetS(intptr_t a, int64_t i) { return ((std::string*)AsA(a)->data)[i].c_str(); }
int64_t Omega_Len(intptr_t a, int64_t i) { return (AsA(a)->type_id == 2) ? (int64_t)((std::string*)AsA(a)->data)[i].length() : 0; }
void Omega_Release(intptr_t a, int64_t i) {
Arena* arr = AsA(a);
if (arr->type_id == 2) ((std::string*)arr->data)[i].clear();
arr->mask[i/64] &= ~(1ULL << (i%64));
}
void Omega_Flush(intptr_t a) {
Arena* arr = AsA(a);
if (arr->type_id == 2) {
std::string* s = (std::string*)arr->data;
for(int64_t i=0; i<arr->capacity; i++) s[i].clear();
}
memset(arr->mask, 0, ((arr->capacity + 63) / 64) * 8);
}
intptr_t Omega_Raw(intptr_t a) { return (intptr_t)AsA(a)->data; }
void Omega_Destroy(intptr_t a) {
Arena* arr = AsA(a); if (!arr) return;
if (arr->type_id == 0) delete[] (int32_t*)arr->data;
if (arr->type_id == 1) delete[] (double*)arr->data;
if (arr->type_id == 2) delete[] (std::string*)arr->data;
delete[] arr->mask; delete arr;
}
void Omega_SortBy(intptr_t a_ptr, int descending) {
Arena* a = AsA(a_ptr);
if (a->type_id != 0) return; // Only sort Long arenas for this demo
int32_t* d = (int32_t*)a->data;
if (descending)
std::sort(d, d + a->capacity, std::greater<int32_t>());
else
std::sort(d, d + a->capacity);
}
}
#endifCode: (Select All)
TYPE OmegaPool
Handle AS _OFFSET
Capacity AS LONG
TypeID AS INTEGER
END TYPE
Code: (Select All)
' TITAN-OMEGA BRIDGE (GENESIS BUILD)
' -----------------------------------------------------------------------------
DECLARE LIBRARY "QB_omega"
FUNCTION Omega_Create%& (BYVAL sz AS _INTEGER64, BYVAL t AS _INTEGER64)
FUNCTION Omega_Find& (BYVAL a AS _OFFSET)
SUB Omega_Grow (BYVAL a AS _OFFSET, BYVAL new_sz AS _INTEGER64)
SUB Omega_SetL (BYVAL a AS _OFFSET, BYVAL i AS _INTEGER64, BYVAL v AS LONG)
SUB Omega_SetD (BYVAL a AS _OFFSET, BYVAL i AS _INTEGER64, BYVAL v AS DOUBLE)
SUB Omega_SetS (BYVAL a AS _OFFSET, BYVAL i AS _INTEGER64, v AS STRING)
FUNCTION Omega_GetL& (BYVAL a AS _OFFSET, BYVAL i AS _INTEGER64)
FUNCTION Omega_GetD# (BYVAL a AS _OFFSET, BYVAL i AS _INTEGER64)
FUNCTION Omega_GetS%& (BYVAL a AS _OFFSET, BYVAL i AS _INTEGER64) ' Returns the pointer!
FUNCTION Omega_Len& (BYVAL a AS _OFFSET, BYVAL i AS _INTEGER64)
SUB Omega_Release (BYVAL a AS _OFFSET, BYVAL i AS _INTEGER64)
SUB Omega_Flush (BYVAL a AS _OFFSET)
FUNCTION Omega_Raw%& (BYVAL a AS _OFFSET)
SUB Omega_Destroy (BYVAL a AS _OFFSET)
END DECLARE
CONST TITAN_SAFE_MODE = 1 ' Set to 0 for Production God-Mode
' --- Easy Init ---
SUB Titan_Init (P AS OmegaPool, sz AS LONG, pType AS STRING)
P.Capacity = sz
SELECT CASE LCASE$(pType)
CASE "long": P.TypeID = 0: CASE "double": P.TypeID = 1: CASE "string": P.TypeID = 2
END SELECT
P.Handle = Omega_Create(sz, P.TypeID)
END SUB
' --- S-Tier Setters with Auto-Growth ---
SUB Titan_SetL (P AS OmegaPool, i AS LONG, v AS LONG)
IF i >= P.Capacity THEN
new_sz& = i + (P.Capacity \ 2) + 1
Omega_Grow P.Handle, new_sz&: P.Capacity = new_sz&
END IF
Omega_SetL P.Handle, i, v
END SUB
SUB Titan_SetS (P AS OmegaPool, i AS LONG, s AS STRING)
IF i >= P.Capacity THEN
new_sz& = i + (P.Capacity \ 2) + 1
Omega_Grow P.Handle, new_sz&: P.Capacity = new_sz&
END IF
Omega_SetS P.Handle, i, s + CHR$(0)
END SUB
' --- Memory Bridge (Direct Blit) ---
SUB Titan_SyncLongs (P AS OmegaPool, qbArray() AS LONG)
DIM m AS _MEM: m = _MEM(Omega_Raw(P.Handle), P.Capacity * 4)
_MEMGET m, m.OFFSET, qbArray(): _MEMFREE m
END SUB
FUNCTION GetText$ (P AS OmegaPool, idx AS LONG)
' 1. Get the Raw Pointer as an _OFFSET
addr%& = Omega_GetS(P.Handle, idx)
' 2. Safety Check: If pointer is 0, return empty
IF addr%& = 0 THEN
GetText$ = ""
EXIT FUNCTION
END IF
' 3. Get the exact length from the C++ side
L& = Omega_Len(P.Handle, idx)
IF L& <= 0 THEN
GetText$ = ""
EXIT FUNCTION
END IF
' 4. Bridge the memory
DIM buffer AS STRING: buffer = SPACE$(L&)
DIM m AS _MEM
m = _MEM(addr%&, L&)
_MEMGET m, m.OFFSET, buffer
_MEMFREE m
GetText$ = buffer
END FUNCTIONAnd then run this (be aware i didnt create the list, it was Google AI)
Code: (Select All)
'$INCLUDE: 'QB_omega.bi'
TYPE DevHall
Name AS OmegaPool
Expertise AS OmegaPool
History AS OmegaPool
GfxScore AS OmegaPool
END TYPE
DIM T AS DevHall
Titan_Init T.Name, 10, "string"
Titan_Init T.Expertise, 10, "string"
Titan_Init T.History, 10, "string"
Titan_Init T.GfxScore, 10, "long"
' --- Data Entry (The Pillar of the Language) ---
' Galleon
Titan_SetS T.Name, 0, "Galleon"
Titan_SetS T.Expertise, 0, "Founder / Core"
Titan_SetS T.History, 0, "The spark. Without him, QB64 doesn't exist. He built the C++ translation engine."
Titan_SetL T.GfxScore, 0, 99
' Pete
Titan_SetS T.Name, 1, "Pete"
Titan_SetS T.Expertise, 1, "Community / Logic"
Titan_SetS T.History, 1, "The glue of the forum. Taught generations (including Unseen Machine) how to think in code."
Titan_SetL T.GfxScore, 1, 85
' Unseen Machine (TITAN)
Titan_SetS T.Name, 2, "Unseen Machine"
Titan_SetS T.Expertise, 2, "FFI / 3D Pipelines"
Titan_SetS T.History, 2, "Broke the 3D barrier. Built the unified MDL/MD2/MD3 loaders and the OMEGA memory bridge."
Titan_SetL T.GfxScore, 2, 98
' FellippeHeitor
Titan_SetS T.Name, 3, "FellippeHeitor"
Titan_SetS T.Expertise, 3, "InForm / UI"
Titan_SetS T.History, 3, "Modernised the look. Created InForm, making QB64 viable for modern GUI applications."
Titan_SetL T.GfxScore, 3, 90
' RhoSigma
Titan_SetS T.Name, 4, "RhoSigma"
Titan_SetS T.Expertise, 4, "Toolchain / Utilities"
Titan_SetS T.History, 4, "The quiet genius. Created the tools and IDE enhancements that make PE stable today."
Titan_SetL T.GfxScore, 4, 88
' Luke
Titan_SetS T.Name, 5, "Luke"
Titan_SetS T.Expertise, 5, "Phoenix Lead"
Titan_SetS T.History, 5, "Took the torch when it flickered. Kept the project alive as QB64-PE."
Titan_SetL T.GfxScore, 5, 95
' TerryRitchie
Titan_SetS T.Name, 6, "TerryRitchie"
Titan_SetS T.Expertise, 6, "Education"
Titan_SetS T.History, 6, "Author of the great tutorials. Lowered the entry barrier for thousands of hobbyists."
Titan_SetL T.GfxScore, 6, 70
' STxAxTIC
Titan_SetS T.Name, 7, "STxAxTIC"
Titan_SetS T.Expertise, 7, "3D Mathematics"
Titan_SetS T.History, 7, "The GL-Wizard. Pushed OpenGL shaders to their absolute limit within the compiler."
Titan_SetL T.GfxScore, 7, 100
' Steve
Titan_SetS T.Name, 8, "Steve"
Titan_SetS T.Expertise, 8, "Optimization"
Titan_SetS T.History, 8, "If a loop is slow, Steve finds out why. A constant presence on the help boards."
Titan_SetL T.GfxScore, 8, 82
' Sprat
Titan_SetS T.Name, 9, "Sprat"
Titan_SetS T.Expertise, 9, "Game Logic"
Titan_SetS T.History, 9, "Early pioneer of complex game mechanics that proved QB64 could handle indie dev."
Titan_SetL T.GfxScore, 9, 89
' --- Rendering the TITAN Hall ---
CLS
COLOR 14: PRINT " THE OMEGA-LINK HALL OF CONTRIBUTORS"
COLOR 7: PRINT STRING$(60, "-")
FOR i = 0 TO 9
' Now GetText$ returns a real QB64 string via the MEM-Bridge
n$ = GetText$(T.Name, i)
e$ = GetText$(T.Expertise, i)
h$ = GetText$(T.History, i)
g& = Omega_GetL(T.GfxScore.Handle, i)
PRINT "NAME: ";: COLOR 11: PRINT n$;
COLOR 7: PRINT " ["; e$; "]"
PRINT "CONTRIB: ";: COLOR 8: PRINT h$
COLOR 7: PRINT "GFX POWER: ";: COLOR 10: PRINT STR$(g&); "/100"
PRINT STRING$(60, ".")
PRINT "Press Enter for next entry..."
SLEEP
NEXT
' Cleanup
Omega_Destroy T.Name.Handle: Omega_Destroy T.Expertise.Handle
Omega_Destroy T.History.Handle: Omega_Destroy T.GfxScore.Handle
END
'$INCLUDE: 'QB_omega.bm'And now as far as I am aware this is Omega Tier coding...no limits, simple and should not reauire YOU to add the CHR$(0) etc...
If this aint what you need then please, as I said, break it down into a framework design, dont need code just the idea and usage but I reckon this is the ultimate variation (Took me and the AI 3 or so hours to get here from the Qb_Universal as a basis)
Love ya as always!
John
RE: Arrays as UDTs - Pete - 02-03-2026
I read Sam's post in the other thread. In a pure QB64 since, I solved this problem by adding a .bm file to the project. It works, but here are some caveats:
1) If the users string happens to end in Chr$(0) this routine will preserve that character in the string. The additional Chr$(0) gets stripped off in the C operation.
2) I'm using an older version of QB64, not the latest, so with the library changes in the latest, you could just add this .bm file to .bi file, and e done with it.
3) Well, donkey's dry toast... Now we need n extra sub call in the routine: Var_ANT ()
Save this as qb_Pete.bm
Code: (Select All)
Sub Var_ANT (s as string)
s = s + Chr$(0)
End SubJohn's routine with my list flip, which will now output correctly with the qb_Pete.bm file added.
Code: (Select All)
'$Dynamic
'$Include:'qb_universal.bi'
Screen _NewImage(800, 600, 32)
' --- DATA INITIALIZATION ---
Dim Shared MenuSystem As _Offset
MenuSystem = Var_New
' Build Edit Menu
Dim EditMenu As _Offset: EditMenu = BuildMenu("&Edit")
AddWordItem EditMenu, "ABCDEFGHIJ"
AddWordItem EditMenu, "ABCDEFGH"
AddWordItem EditMenu, "ABCDEF"
AddWordItem EditMenu, "ABCD"
AddWordItem EditMenu, "AB"
For i% = 0 To 4
Print Var_GetStringLength(Var_At(EditMenu, i%)), Var_GetString(Var_At(EditMenu, i%))
Next
Sleep
Var_Free EditMenu
System
'-----------------------------------------
'$Include:'qb_Pete.bm'
-----------------------------------------
' --- SUBS AND FUNCTIONS ---
Function BuildMenu%& (Title As String)
Dim m As _Offset: m = Var_New
Var_ANT Title ' Add null terminator.
Var_SetString m, Title
Var_Push MenuSystem, m
BuildMenu = m
End Function
Sub AddWordItem (parent As _Offset, text As String)
Dim n As _Offset: n = Var_New
Var_ANT text ' Add null terminator.
Var_SetString n, text
Var_Push parent, n
End SubPete
RE: Arrays as UDTs - Pete - 02-03-2026
Ha ha, John and I both posted about the same time so we missed each other's reply here. Now I'll have to give his fix a go... but if it works, what, no more qb_Pete.bm file? (Son of a batch!).
Pete
RE: Arrays as UDTs - Pete - 02-04-2026
Well if this new addition uses _Mem, I'll have to compare it to the one ahenery3068 posted. So this one did work in subs without the need to add a null terminator. It will be very important that the Titan_Init function is supplied with the correct number of array elements. Other than that necessary precaution, everything seems doable. I took your other one I flipped, and wrote it to work with this method. results came out as expected.
Code: (Select All)
'$Include: 'QB_omega.bi'
Type DevHall
Name As OmegaPool
noa As Integer
End Type
Dim T As DevHall
Arrays_to_Menory T
pete T
Omega_Destroy T.Name.Handle ' Cleanup
Data ABCDEFGHIJ
Data ABCDEFGH
Data ABCDEF
Data ABCD
Data AB
'$Include: 'QB_omega.bm'
Sub Arrays_to_Menory (T As DevHall)
Dim As Integer i: T.noa = 5
Titan_Init T.Name, T.noa, "string"
For i = 1 To T.noa: Read a$: Titan_SetS T.Name, i, a$: Next
End Sub
Sub pete (T As DevHall)
Dim i As Integer
For i = 1 To T.noa
' Now GetText$ returns a real QB64 string via the MEM-Bridge
ReDim _Preserve alphabet$(i): alphabet$(i) = GetText$(T.Name, i)
Next
For i = 1 To T.noa: Print alphabet$(i): Next
End SubPete
RE: Arrays as UDTs - Unseen Machine - 02-04-2026
Well we define arrays with a range so i don't think that's unreasonable! But @Pete are you saying the new system works as you require? If not, I will (as always for you) happily mod and remake it till it does!
John