behold jofers

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
cha0s
Site Admin
Posts: 5319
Joined: May 27, 2005 6:42
Location: USA
Contact:

behold jofers

Post by cha0s »

...as your alias hack allows us to access array descriptors, without a seperate routine to attain descriptor address

Code: Select all

Type FBArrayDim

  Elements As Integer
  LBound As Integer
  UBound As Integer

End Type

Type FBArray

  dat As Any Pointer
  pnt As Any Pointer
  sz As Integer
  Element_Len As Integer
  Dimensions As Integer
  DimTB As FBArrayDim Ptr

End Type 



#Define DimTable_ptr(x)             _
  cptr( FBArrayDim Ptr, @x->DimTB )




Declare Sub array_Append Alias "ArrayAppend" ( someArray() As Integer, pushData As Integer )
Declare Sub array_Append_hooked Alias "ArrayAppend" ( ByRef arydat As Any Ptr, pushData As Integer )


Declare Function array_Pop Alias "ArrayPop" ( blah() As Integer ) As Integer
Declare Function array_Pop_hooked Alias "ArrayPop" ( array_desc As Any Ptr ) As Integer


'Use an array as a stack
Redim myArray(0) As Integer

array_Append myArray(), 51
array_Append myArray(), 52
array_Append myArray(), 53
Print array_Pop( myArray() )
Print myArray( UBound(myArray) ); ", "; UBound(myArray)

Sleep



Sub array_Append_hooked( ByRef array_desc As Any Ptr, pushData As Integer )

  Dim As fbarray Ptr fb_arr = @array_desc

  fb_arr->sz += 4
  
  DimTable_ptr( fb_arr )[0].UBound += 1
  DimTable_ptr( fb_arr )[0].elements += 1

  Reallocate fb_arr->dat, fb_arr->sz
  
  cptr( Integer Ptr, fb_arr->dat )[DimTable_ptr( fb_arr )[0].UBound] = pushdata

End Sub


Function array_Pop_hooked( array_desc As Any Ptr ) As Integer
  

  Dim As fbarray Ptr fb_arr = @array_desc
  Dim pop_Data As Integer

  If fb_arr->sz = 0 Then Return 0

  
    pop_Data = cptr( Integer Ptr, fb_arr->dat )[DimTable_ptr( fb_arr )[0].UBound]
   
    fb_arr->sz -= 4     
    
    DimTable_ptr( fb_arr )[0].UBound -= 1
    DimTable_ptr( fb_arr )[0].Elements -= 1
       
    Reallocate fb_arr->dat, fb_arr->sz
   
    Return pop_Data


End Function
jofers
Posts: 1525
Joined: May 27, 2005 17:18

Post by jofers »

Cool stuff :) Never thought of that before. I remember writing a GetArrayDescriptor() way back when, but then I had to go through all the trouble of compiling it into a library, and then changing the header, this way is much cooler.
cha0s
Site Admin
Posts: 5319
Joined: May 27, 2005 6:42
Location: USA
Contact:

Post by cha0s »

hehe, i've been having fun screwing around with this one...

Code: Select all

Enum Arg_Types

  ARG_INT = 1
  ARG_STR
  ARG_SNG
  ARG_DBL
  ARG_LNG
  ARG_PTR

End Enum


Type FBArrayDim

  Elements As Integer
  LBound As Integer
  UBound As Integer

End Type

Type FBArray

  dat As Any Pointer
  pnt As Any Pointer
  sz As Integer
  Element_Len As Integer
  Dimensions As Integer
  DimTB As FBArrayDim Ptr

End Type 

#Include "crt.bi"


#Define array_DimTable(x)           _
  cptr( FBArrayDim Ptr, @x->DimTB )




Declare Sub array_Append Overload Alias "ArrayAppend" ( someArray() As Integer, pushData As Integer, id As Integer = ARG_INT )
Declare Sub array_Append          Alias "ArrayAppend" ( someArray() As String, pushData As String, id As Integer = ARG_STR )
Declare Sub array_Append          Alias "ArrayAppend" ( someArray() As Single, pushData As Single, id As Integer = ARG_SNG )
Declare Sub array_Append          Alias "ArrayAppend" ( someArray() As Double, pushData As Double, id As Integer = ARG_DBL )
Declare Sub array_Append          Alias "ArrayAppend" ( someArray() As LongInt, pushData As LongInt, id As Integer = ARG_LNG )
Declare Sub array_Append          Alias "ArrayAppend" ( someArray() As Any Ptr, pushData As Any Ptr, id As Integer = ARG_PTR )

Declare Sub array_Append_hooked Alias "ArrayAppend" ( ByRef arydat As Any Ptr, pushData As Any Ptr, id As Integer )


Declare Sub array_Pop Overload Alias "ArrayPop" ( blah() As Integer, ret As Integer, id As Integer = ARG_INT )
Declare Sub array_Pop          Alias "ArrayPop" ( blah() As String , ret As String , id As Integer = ARG_STR )
Declare Sub array_Pop          Alias "ArrayPop" ( blah() As Single , ret As Single , id As Integer = ARG_SNG )
Declare Sub array_Pop          Alias "ArrayPop" ( blah() As Double , ret As Double , id As Integer = ARG_DBL )
Declare Sub array_Pop          Alias "ArrayPop" ( blah() As LongInt, ret As LongInt, id As Integer = ARG_LNG )
Declare Sub array_Pop          Alias "ArrayPop" ( blah() As Any Ptr, ret As Any Ptr, id As Integer = ARG_PTR )

Declare Sub array_Pop_hooked Alias "ArrayPop"( array_desc As Any Ptr, ret As Any Ptr, id As Integer )



Declare Function array_CleanPopPtr( a() As Any Ptr ) As Any Ptr
Declare Function array_CleanPopLng( a() As LongInt ) As LongInt
Declare Function array_CleanPopDbl( a() As Double ) As Double
Declare Function array_CleanPopSng( a() As Single ) As Single
Declare Function array_CleanPopStr( a() As String ) As String
Declare Function array_CleanPopInt( a() As Integer ) As Integer

'Use an array as a stack
Redim myArray(0) As String
Dim As String ret

array_Append myArray(), "Testing"
array_Append myArray(), "Strings"
array_Append myArray(), "blahblahblahblahblahblahblahblahblahblahblahblah"
array_Append myArray(), "love bu"

array_pop( myArray(), ret )
? ret

? array_CleanPopStr( myarray() )

Print myArray( UBound(myArray) ); ", "; UBound(myArray)


Sleep


Sub array_Append_hooked( ByRef array_desc As Any Ptr, ByRef pushData As Any Ptr, id As Integer )
  
  Dim As fbarray Ptr fb_arr = @array_desc
  Dim As Integer det, optim
  
  Select Case id

    Case ARG_INT : det = 4
    Case ARG_STR : det = 12
    Case ARG_SNG : det = 4
    Case ARG_DBL : det = 8
    Case ARG_LNG : det = 8
    Case ARG_PTR : det = 4
      
  End Select
  
  optim = fb_arr->sz
  fb_arr->sz += det
  
  array_DimTable( fb_arr )[0].UBound += 1
  array_DimTable( fb_arr )[0].elements += 1

  Reallocate fb_arr->dat, fb_arr->sz
  memset( fb_arr->dat + optim, 0, det )

  
  Select Case As Const id

    Case ARG_INT
      cptr( Integer Ptr, fb_arr->dat )[array_DimTable( fb_arr )[0].UBound] = *cptr( Integer Ptr, @pushdata )
  
    Case ARG_STR
      cptr( String Ptr, fb_arr->dat )[array_DimTable( fb_arr )[0].UBound] = *cptr( zString Ptr, pushdata )
  
    Case ARG_SNG
      cptr( Single Ptr, fb_arr->dat )[array_DimTable( fb_arr )[0].UBound] = *cptr( Single Ptr, @pushdata )
  
    Case ARG_DBL
      cptr( Double Ptr, fb_arr->dat )[array_DimTable( fb_arr )[0].UBound] = *cptr( Double Ptr, @pushdata )
  
    Case ARG_LNG
      cptr( LongInt Ptr, fb_arr->dat )[array_DimTable( fb_arr )[0].UBound] = *cptr( LongInt Ptr, @pushdata )
  
    Case ARG_PTR
      cptr( Any Ptr Ptr, fb_arr->dat )[array_DimTable( fb_arr )[0].UBound] = *cptr( Any Ptr Ptr, @pushdata )
      
  End Select
  

End Sub


Sub array_pop_hooked( ByRef array_desc As Any Ptr, ret As Any Ptr, id As Integer )
  
  Dim As fbarray Ptr fb_arr = @array_desc
  Dim As Integer det
  
  Select Case id

    Case ARG_INT 
      det = 4
      *cptr( Integer Ptr, @ret ) = cptr( Integer Ptr, fb_arr->dat )[array_DimTable( fb_arr )[0].UBound]
    Case ARG_STR 
      det = 12
      *cptr( String Ptr, @ret ) = ""
      *cptr( String Ptr, @ret ) = cptr( String Ptr, fb_arr->dat )[array_DimTable( fb_arr )[0].UBound]
      cptr( String Ptr, fb_arr->dat )[array_DimTable( fb_arr )[0].UBound] = ""
    Case ARG_SNG 
      det = 4
      *cptr( Single Ptr, @ret ) = cptr( Single Ptr, fb_arr->dat )[array_DimTable( fb_arr )[0].UBound]
    Case ARG_DBL 
      det = 8
      *cptr( Double Ptr, @ret ) = cptr( Double Ptr, fb_arr->dat )[array_DimTable( fb_arr )[0].UBound]
    Case ARG_LNG 
      det = 8
      *cptr( LongInt Ptr, @ret ) = cptr( LongInt Ptr, fb_arr->dat )[array_DimTable( fb_arr )[0].UBound]
    Case ARG_PTR 
      det = 4
      *cptr( Any Ptr Ptr, @ret ) = cptr( Any Ptr Ptr, fb_arr->dat )[array_DimTable( fb_arr )[0].UBound]
      
  End Select
  
  fb_arr->sz -= det
  
  array_DimTable( fb_arr )[0].UBound -= 1
  array_DimTable( fb_arr )[0].elements -= 1

  Reallocate fb_arr->dat, fb_arr->sz


End Sub


'' little helpers :>
Function array_CleanPopInt( a() As Integer ) As Integer : Dim As Integer ret : array_Pop( a(), ret ) : Return ret : End Function
Function array_CleanPopStr( a() As String  ) As String  : Dim As String  ret : array_Pop( a(), ret ) : Return ret : End Function
Function array_CleanPopSng( a() As Single  ) As Single  : Dim As Single  ret : array_Pop( a(), ret ) : Return ret : End Function
Function array_CleanPopDbl( a() As Double  ) As Double  : Dim As Double  ret : array_Pop( a(), ret ) : Return ret : End Function
Function array_CleanPopLng( a() As LongInt ) As LongInt : Dim As LongInt ret : array_Pop( a(), ret ) : Return ret : End Function
Function array_CleanPopPtr( a() As Any Ptr ) As Any Ptr : Dim As Any Ptr ret : array_Pop( a(), ret ) : Return ret : End Function

now with extra versatilitude
maddogg6
Posts: 824
Joined: Dec 07, 2005 22:58
Contact:

Post by maddogg6 »

cha0s wrote:now with extra versatilitude
LOL -

Didn't I see this 'tag line' on a roll of duct tape... or was it the 'New and Improved Super Glue' ??
cha0s
Site Admin
Posts: 5319
Joined: May 27, 2005 6:42
Location: USA
Contact:

Post by cha0s »

i dunno, i pulled it out of my @$$ :p
Post Reply