Vwwxrf

I want to write my snake game procedurally, using as much windows call as I can so as to practice. Looking into GetAsyncKeyState to capture keyboard inputs and play sound functions. Also making a sweet user interface. Fun!

Also shout to bytecomb for providing example as to how to traverse the array structure, used his code function to find ptr to element in array!!

API CALLS

Option Explicit

Private Declare PtrSafe Function VarPtrArray Lib "VBE7" Alias "VarPtr" _
 (ByRef Var() As Any) As LongPtr

Private Declare PtrSafe Sub CopyMemoryI Lib "kernel32.dll" Alias "RtlMoveMemory" _
 (ByVal dst As LongPtr, ByVal src As LongPtr, ByVal Length As Long)

Private Declare PtrSafe Sub CopyMemoryII Lib "kernel32.dll" Alias "RtlMoveMemory" _
 (ByRef dst As SAFEARRAY, ByVal src As LongPtr, ByVal Length As Long)

Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" _
 (ByVal vKey As Long) As Boolean

DATA STRUCTS

Private Type SAFEARRAY_BOUND
 cElements As Long
 lLbound As Long
End Type

Private Type SAFEARRAY
 cDims As Integer
 fFeatures As Integer
 cbElements As Long
 cLocks As Long
 pvData As LongPtr
 rgsabound(0) As SAFEARRAY_BOUND
End Type

Private Type SnakePart
 Column As Long
 Row As Long
End Type

Private Const SNAKEPART_BYTELENGTH = 8

FUNCTIONS

Private Function ArrayPush(ByRef ArrayOriginal() As SnakePart, ByRef ElementToAdd As SnakePart) As SnakePart()
Dim NewLength As Long
Dim CopiedBytes As Long
Dim NewBytes As Long

 NewLength = UBound(ArrayOriginal) + 1
 ReDim ArrayPush(NewLength)

 CopiedBytes = NewLength * SNAKEPART_BYTELENGTH
 NewBytes = SNAKEPART_BYTELENGTH

 CopyMemoryI ArrayElementGetPointer(ArrayPush, 0, SNAKEPART_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, 0, SNAKEPART_BYTELENGTH), CopiedBytes
 CopyMemoryI ArrayElementGetPointer(ArrayPush, NewLength, SNAKEPART_BYTELENGTH), VarPtr(ElementToAdd), NewBytes
End Function

Private Function ArrayPop(ByRef ArrayOriginal() As SnakePart) As SnakePart()
Dim NewLength As Long
Dim CopiedBytes As Long

 NewLength = UBound(ArrayOriginal) - 1
 ReDim ArrayPop(NewLength)

 CopiedBytes = UBound(ArrayOriginal) * SNAKEPART_BYTELENGTH

 CopyMemoryI ArrayElementGetPointer(ArrayPop, 0, SNAKEPART_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal(), 0, SNAKEPART_BYTELENGTH), CopiedBytes
End Function

Private Function ArrayShift(ByRef ArrayOriginal() As SnakePart, ByRef ElementToAdd As SnakePart) As SnakePart()
Dim NewLength As Long
Dim CopiedBytes As Long
Dim NewBytes As Long

 NewLength = UBound(ArrayOriginal) + 1
 ReDim ArrayShift(NewLength)

 CopiedBytes = NewLength * SNAKEPART_BYTELENGTH
 NewBytes = SNAKEPART_BYTELENGTH

 CopyMemoryI ArrayElementGetPointer(ArrayShift, 1, SNAKEPART_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, 0, SNAKEPART_BYTELENGTH), CopiedBytes
 CopyMemoryI ArrayElementGetPointer(ArrayShift, 0, SNAKEPART_BYTELENGTH), VarPtr(ElementToAdd), NewBytes
End Function

Private Function ArrayUnshift(ByRef ArrayOriginal() As SnakePart) As SnakePart()
Dim NewLength As Long
Dim CopiedBytes As Long

 NewLength = UBound(ArrayOriginal) - 1
 ReDim ArrayUnshift(NewLength)

 CopiedBytes = UBound(ArrayOriginal) * SNAKEPART_BYTELENGTH

 CopyMemoryI ArrayElementGetPointer(ArrayUnshift, 0, SNAKEPART_BYTELENGTH), ArrayElementGetPointer(ArrayOriginal, 1, SNAKEPART_BYTELENGTH), CopiedBytes
End Function

Private Function ArrayElementGetPointer(ByRef Arr() As SnakePart, ByVal ElementIndex As Long, ByVal ElementByteLength As Long) As LongPtr
Dim ptrToArrayVar As LongPtr
Dim ptrToSafeArray As LongPtr
Dim ptrToArrayData As LongPtr
Dim ptrCursor As LongPtr
Dim uSAFEARRAY As SAFEARRAY

 ' Get Pointer To Array *Variable*
 ptrToArrayVar = VarPtrArray(Arr)
 ' Get Pointer To Array Variable *SAFEARRAY* By Directly Reading Array Variable
 CopyMemoryI VarPtr(ptrToSafeArray), ptrToArrayVar, 8
 ' Read The SAFEARRAY Structure
 CopyMemoryII uSAFEARRAY, ptrToSafeArray, LenB(uSAFEARRAY)
 ' Get Pointer To Array Data
 ptrToArrayData = uSAFEARRAY.pvData
 ' Get Pointer To Array Element
 ptrCursor = ptrToArrayData + (ElementIndex * ElementByteLength)
 ArrayElementGetPointer = ptrCursor
End Function

TESTS

Private Sub test()

 Dim x(3) As SnakePart
 Dim sp As SnakePart

 sp.Column = 1
 sp.Row = 1

 x(0) = sp
 x(1) = sp
 x(2) = sp
 x(3) = sp

 ' expect all 1s
 Debug.Print x(0).Column
 Debug.Print x(1).Column
 Debug.Print x(2).Column
 Debug.Print x(3).Column
 Debug.Print "_______________________"

 sp.Column = 2

 Dim temparry() As SnakePart
 temparry = x
 temparry = ArrayPush(temparry, sp)

 Debug.Print "expect 2 at end"
 Debug.Print temparry(0).Column
 Debug.Print temparry(1).Column
 Debug.Print temparry(2).Column
 Debug.Print temparry(3).Column
 Debug.Print temparry(4).Column
 Debug.Print "_______________________"

 temparry = ArrayPop(temparry)

 Debug.Print "expect all 1"
 Debug.Print temparry(0).Column
 Debug.Print temparry(1).Column
 Debug.Print temparry(2).Column
 Debug.Print temparry(3).Column
 Debug.Print "_______________________"

 temparry = ArrayShift(temparry, sp)

 Debug.Print "expect 2 at start"
 Debug.Print temparry(0).Column
 Debug.Print temparry(1).Column
 Debug.Print temparry(2).Column
 Debug.Print temparry(3).Column
 Debug.Print temparry(4).Column
 Debug.Print "_______________________"

 temparry = ArrayUnshift(temparry)

 Debug.Print "expect all 1"
 Debug.Print temparry(0).Column
 Debug.Print temparry(1).Column
 Debug.Print temparry(2).Column
 Debug.Print temparry(3).Column
End Sub