Sorry your browser is not supported!

Function addToArray(arrayPtr As dword)
   arrayPTR insert at bottom arrayPtr
endFunction

Sync on
do
cls
set cursor 0, 0
print "VK_F1=";get key state(0x70)

Print "0x70: ",HEX TO DECIMAL("0x70")
`Print "0x71: ",HEX TO DECIMAL("0x71")
`Print "0x72: ",HEX TO DECIMAL("0x72")

sync
loop
end

n= Get Ptr To Function("testMe")
Print n

Print "Hello world"

Wait Key
End

REM DBO Loader sub-routine
_loader:
    ` Clear all working files
    if file exist("level1.dbw") then delete file "level1.dbw"
    
    ` Start assembling a combined file
    Total = file size("Maps/room1.dbo") + file size("Maps/room2.dbo") + file size("Maps/room3.dbo") + file size("Maps/door1.dbo") + file size("Maps/door2.dbo")
    Offset = 0
    
    map file to bank "level1.dbw", 1, Total
    
    ` Add dbo's to the file
    ` Room 1
    map file to bank "Maps/room1.dbo", 2
    copy bank 2, 0, get bank size(2), 1, Offset
    inc Offset, get bank size(2)
    delete bank 2
    `delete file "Maps/room1.dbo"
    ` Room 2
    map file to bank "Maps/room2.dbo", 2
    copy bank 2, 0, get bank size(2), 1, Offset
    inc Offset, get bank size(2)
    delete bank 2
    `delete file "Maps/room2.dbo"
    ` Room 3
    map file to bank "Maps/room3.dbo", 2
    copy bank 2, 0, get bank size(2), 1, Offset
    inc Offset, get bank size(2)
    delete bank 2
    `delete file "Maps/room3.dbo"
    ` Door 1
    map file to bank "Maps/door1.dbo", 2
    copy bank 2, 0, get bank size(2), 1, Offset
    inc Offset, get bank size(2)
    delete bank 2
    `delete file "Maps/door1.dbo"
    ` Door 2
    map file to bank "Maps/door2.dbo", 2
    copy bank 2, 0, get bank size(2), 1, Offset
    inc Offset, get bank size(2)
    delete bank 2
    `delete file "Maps/door2.dbo"
    
    delete bank 1
    ` All done. The combined file is ready
    
    ` Load the combined file
    map file to bank "level1.dbw", 1
    
    ` Load all objects from that file
    Offset = 0
    ObjectNo = Level1
    repeat
       ` Search for the magic string
       Offset = search bank(1, Offset, "MAGICDBO")
       if Offset >= 0
          ` Ensure that the previous 4 bytes match the length of the string we expect
          if bank integer(1, Offset-4) = 8
             ` Ok, we know that we've found a match
             if ObjectNo=Door1 then ObjectNo=Door2
             if ObjectNo=Room3 then ObjectNo=Door1
             if ObjectNo=Room2 then ObjectNo=Room3
             if ObjectNo=Level1 then ObjectNo=Room2
             make object from bank ObjectNo, 1, Offset-4
             ` Advance the start point of the next search
             inc Offset
          endif
       endif
    until Offset < 0
    
    delete bank 1
return

   Call Function Ptr  Get Ptr To Function(Get Split Word$(1)),PL(0),PL(1),PL(2),PL(3),PL(4),PL(5),PL(6),PL(7),PL(8)

a = 0

Do

Cls

a = Wrap ( a+1, 0, 0 )
Text 0, 0, Str$ ( a )

Sync
wait 1000

Loop

Dim Test(0) As String

Test(0) = "H"

ptr = Get Array Item Ptr ( Test(), 0 )

Exit Prompt Peek string ( ptr ), "Message"
End

Dim Test(0) As String

Test(0) = "H"

ptr = Get Array Item Ptr ( Test(), 0 )
strptr = Peek Dword( ptr )

Exit Prompt Peek string ( strptr ), "Message"
End

imgID As Integer
`Sync On : Sync Rate 30

`Make Object Cube 1,1

Do

imgID = Find Free Image()
Text 0,0, Str$( imgID )

Sync

Wait 100

Loop

imgID As Integer
Sync On : Sync Rate 30

Make Object Cube 1,1

Do

imgID = Find Free Image()
Text 0,0, Str$( imgID )

Sync

Wait 100

Loop

While Not Arglist EOL(arglist)
   Value=Arglist DWord(arglist)
   code...
   code...
EndWhile

`Comment/De-comment as needed.

`------------------------------

Sync On

`Any image can be used here...just alter the string accordingly.
strImgName  As String  = "D:Dark Basic ProfessionalMediaTexturesbrick1_T.BMP"

iStart      As Integer = 1 `10000001
iEnd        As Integer = 100 `10000100
iTimeStart  As Integer
iTimeTaken  As Integer

`------------------------------

Text 0, 0, "Loading " + Str$ ( iEnd - iStart + 1 ) + " entities...please stand by." : Sync : Sync

iTimeStart = Timer()

For x = iStart To iEnd

   Load Image strImgName, x
   `Make Object Cube x, 1
Next

iTimeTaken = Timer() - iTimeStart

`###############################
`MAIN LOOP
`###############################

Do : Cls

Text 0, 0, "Time taken: " + Str$ ( iTimeTaken ) + " ms"

Sync : Loop

`-------------------------------
`Make array from file

`This will load a file delimited by carriage returns, and store its contents in a string-based array.
`The external array must be string based as well.
`-------------------------------

Function MakeArrayFromFile( strFilename As String, ptrArrayExternal As Dword )

`Create an array of a size that equals the number of lines in the file
Dim arrTransfer( LinesInFile( strFilename ) - 1 ) As String

`Load the file into the array
Load Array strFilename, arrTransfer()

`Retrieve the arrTransfer() array pointer
Local ptrArrTransfer As Dword : ptrArrTransfer = Get ArrayPtr ( arrTransfer() )

`Link the external array to the local array
Link ArrayPtr ptrArrayExternal, ptrArrTransfer 

EndFunction

iWordOne As Integer = 1
iWordTwo As Integer = 2
iNumWords As Integer

strString As String = "Widget=Left,Top,Width,Height,IsVisible,IsActive"
strProperty As String
strData As String

`-------------------------------

Split String strString, "="

strProperty = Get Split Word$ ( iWordOne )
strData = Get Split Word$ ( iWordTwo )

Text 0, 0, "strProperty: " + strProperty
Text 0, 10, "strData: " + strData
Text 0, 20, "Split Count: " + Str$ ( Split Count() )

Text 0, 40, "Main string split ( delimiter '=' )"
Text 0, 50, "Press any key to continue"
Sync : Wait Key

`-------------------------------

Cls

Split String strData, ","

iNumWords = Split Count()

Dim arrData( iNumWords - 1 ) As String

For cIndex = 1 To iNumWords

   arrData( cIndex - 1 ) = Get Split Word$ ( cIndex )

   Text 0, ( cIndex * 10 ) - 10, "Data: " + Str$ ( cIndex ) + ": " + arrData( cIndex - 1 )
Next

Text 0, iNumWords * 10, "Split Count: " + Str$ ( iNumWords )

Text 0, ( iNumWords * 10 ) + 20, "Data string split ( delimiter ',' )"
Text 0, ( iNumWords * 10 ) + 30, "Press any key to continue"
Sync : Wait Key

`-------------------------------

End

Type udtGeneric
   strString   As String
   iInteger    As Integer
EndType

`-------------------------------
`Non-UDT array...Peek String

Dim arrTestA( 0 ) As String : arrTestA( 0 ) = "Hello"

ptrArrayItem = Get Array Item Ptr ( arrTestA(), 0 ) : ptrArrayString = Peek Dword ( ptrArrayItem )

Text 0, 0, Peek String ( ptrArrayString )

Text 0, 10, "Non-UDT array...Peek String"
Text 0, 20, "Press any key to continue"
Sync : Wait Key

`-------------------------------
`Non-UDT array...Poke String

Cls

Poke String ptrArrayString, "World"

Text 0, 0, Peek String ( ptrArrayString )

Text 0, 10, "Non-UDT array...Poke String"
Text 0, 20, "Press any key to continue"
Sync : Wait Key

`-------------------------------
`UDT array...Peek String

Cls

Dim arrTestB( 0 ) As udtGeneric : arrTestB( 0 ).strString = "Hello 2"

ptrArrayItem = Get Array Item Ptr ( arrTestB(), 0 )

iArrayOffset = Get Array Field Offset ( arrTestB(), 1 )

ptrArrayField = ptrArrayItem + iArrayOffset

ptrArrayString = Peek Dword ( ptrArrayField )

Text 0, 0, Peek String ( ptrArrayString )

Text 0, 10, "UDT array...Peek String"
Text 0, 20, "Press any key to continue"
Sync : Wait Key

`-------------------------------
`UDT array...Poke String

Cls

Poke String ptrArrayString, "World 2"

Text 0, 0, Peek String ( ptrArrayString )

Text 0, 10, "UDT array...Poke String"
Text 0, 20, "Press any key to continue"
Sync : Wait Key


`-------------------------------
`UDT array...Peek Integer

Cls

arrTestB( 0 ).iInteger = 54321

ptrArrayItem = Get Array Item Ptr ( arrTestB(), 0 )

iArrayOffset = Get Array Field Offset ( arrTestB(), 2 )

ptrArrayField = ptrArrayItem + iArrayOffset

Text 0, 0, Str$ ( Peek Integer ( ptrArrayField ) )

Text 0, 10, "UDT array...Peek Integer"
Text 0, 20, "Press any key to continue"
Sync : Wait Key

`-------------------------------
`UDT array...Poke Integer

Cls

Poke Integer ptrArrayField, 98760

Text 0, 0, Str$ ( Peek Integer ( ptrArrayField ) )

Text 0, 10, "UDT array...Poke Integer"
Text 0, 20, "Press any key to continue"
Sync : Wait Key

`-------------------------------

End

Function MakeArrayFromFile( strFilename As String )

`Create an array of a size that equals the number of lines in the file
Dim arrTransfer( LinesInFile( strFilename ) - 1 ) As String

`Load the file into the array
Load Array strFilename, arrTransfer()

`Retrieve the arrTransfer() array pointer
Local ptrArrTransfer As Dword
ptrArrTransfer = Get ArrayPtr ( arrTransfer() )

`Unlink the array storage from the array
Unlink Array arrTransfer() 

EndFunction ptrArrTransfer

function DestroyArrayPtr( ptr as dword )
   dim Array() as integer : ` type does NOT matter as we're not going to read/write the array
   link array Array(), ptr
   undim Array()
endfunction

Type udtLstProperties
   strName As String
   strImg As String
EndType

`-------------------------------

Type udtGeneric
   strString As String
EndType

Dim arrGeneric( 1 ) As udtGeneric

arrGeneric( 0 ).strString = "WidgetIm"
arrGeneric( 1 ).strString = "WidgetImage.bmp"

iNumProperties = 2

`-------------------------------

Dim arrLocal( 0 ) As udtLstProperties

`This line must be in place to "activate" the possibility of writing strings to the array.
`It's taken me ages to work that out.
arrLocal( 0 ).strName = ""

ptrArrayItem = Get Array Item Ptr ( arrLocal(), 0 )

iArrayOffset = Get Array Field Offset ( arrLocal(), 1 )
ptrArrayField = ptrArrayItem + iArrayOffset

ptrArrayFieldStr = Peek Dword ( ptrArrayField )

Poke String ptrArrayFieldStr, arrGeneric( 1 ).strString

Text 0, 0, "strName: " + arrLocal( 0 ).strName

Sync : Wait Key

End

dim a(0) as string

` Get a pointer to the array item
ItemAddr = get array item ptr( a(), 0 )

` Free any existing string (note: safe even if the pointer is 0)
delete memory peek dword( ItemAddr )

` Make a new string and get its pointer
NewStringAddress = MakeStringPtr( "Hello World" )

` Poke the new string pointer into the array
poke ItemAddr, NewStringAddress

print a(0)

wait key
end

function MakeStringPtr(SourceString as string)
   local dim Temp(0) as string
   local ArrayItemAddr as dword
   local StringAddr as dword

   ` Put the string into the array
   Temp(0) = SourceString

   ` Get a pointer to the string pointer
   ArrayItemAddr = get array item ptr( Temp(), 0 )

   ` Get the string address
   StringAddr = peek dword( ArrayItemAddr )

   ` Overwrite the string pointer to stop it being deallocated when undimming the temp array
   poke dword ArrayItemAddr, 0

   ` Cleanly destroy what's left of the array
   undim Temp()
endfunction StringAddr