Copy Arrays

General discussion for topics related to the FreeBASIC project or its community.
pidd
Posts: 31
Joined: Nov 11, 2022 16:27

Copy Arrays

Post by pidd »

Why do basics hardly ever have a copy array? Or even better still a array block copy?

Code: Select all

a() = b()
a(6 to 8) = b(3 to 5)
a(0 to 15) = a(31 to 46)
a(1 to *) = b(1 to 8)
It would appear to be highly masochistic not to have this as an operation.

50% of the time it might be poor programming and yes it is expensive timewise but the language is supposed to be there to simplify not educate. I'm sure every programmer has wished for it. I think one basic had a(*) = b(*) or similar and may have also had the useful a(*) = 0

What I also like about it is in keeping with the tradition of basic, even a person who has never come across the language (or even a non-programmer) can guess exactly what it does. This generally is the supremacy of Basic unlike other more hieroglyphic languages.

...... and this is where someone tells me it already has :roll: If necessary I claim the age defence now I have progressed past simple stupi-dity.
jevans4949
Posts: 1186
Joined: May 08, 2006 21:58
Location: Crewe, England

Re: Copy Arrays

Post by jevans4949 »

Seems to me it would be a good idea, though may need to consder what happens when arrays are different sizes.

We had this in PL/1 back in the 1970's. Along with "X=Y, by name" where fields in one structure could be copied to another with the same names, taking care of type conversions on the way. Useful for printouts amongst other things.
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Copy Arrays

Post by paul doe »

It's not as 'simple' as it might appear at first glance. For example, what happens when you have arrays of complex types (that might also include arrays of complex types as well)? Or arrays of types that refer to other types (via pointer)?
pidd
Posts: 31
Joined: Nov 11, 2022 16:27

Re: Copy Arrays

Post by pidd »

Cloning an array is simple and is already done internally when calling functions etc which also does the type checking etc, to include it in the language is virtually only a matter of exposing existing functionality to the programming syntax.

It is such a fundamental part of programming I've always been amazed its never come about. How many billions of for-next loops and associated counter declarations would have been saved.

Block (partial) copying would be a bonus but wasn't my main concern but I struggle to think of it as complicated as soon as you are past the type checking stage.
coderJeff
Site Admin
Posts: 4313
Joined: Nov 04, 2005 14:23
Location: Ontario, Canada
Contact:

Re: Copy Arrays

Post by coderJeff »

pidd wrote: Jan 03, 2023 15:20 Cloning an array is simple and is already done internally when calling functions etc which also does the type checking etc, to include it in the language is virtually only a matter of exposing existing functionality to the programming syntax.
"Cloning an array is simple"
- cloning arrays of simple (trivial) types is simple, cloning arrays of complex types is not

"already done internally when calling functions"
- this is incorrect. Arrays are passed by descriptor. The descriptor is a complex internal object that manages some array properties like memory location, dimensions, bounds, but *not* data type

" to include it in the language is virtually only a matter of exposing existing functionality to the programming syntax"
- for simple (trivial) types the matter is not too much.
- for complex types (like types containing STRING or any types with fields containing contructors/destructors and other object like stuff) it is hard to do.

For simple stuff, some internals can be accessed. Example next post.
coderJeff
Site Admin
Posts: 4313
Joined: Nov 04, 2005 14:23
Location: Ontario, Canada
Contact:

Re: Copy Arrays

Post by coderJeff »

CopyArray( dst(), src() ) function for copying arrays of simple types.

[Any data types containing STRING or complex types can't be used since those internals aren't exposed in any way. Adding to the compiler for all types is hard to do (much work).]

Single module (copyarray.bas) to implement the CopyArray() function for simple types:

Code: Select all

#cmdline "-lib"

'' copyarray.bas

#include once "fbc-int/memory.bi"
#include once "fbc-int/array.bi"
#define NULL (0)

private function hCopyArray _
	( _
		byval dst as fbc.FBARRAY ptr, _
		byval src as fbc.FBARRAY ptr _ 
	) as boolean

	'' does the destination descriptor have enough space in the dim table?
	var src_dims = (src->flags and fbc.FBARRAY_FLAGS_DIMENSIONS)
	var dst_dims = (dst->flags and fbc.FBARRAY_FLAGS_DIMENSIONS)
	if( src_dims > dst_dims ) then
		return false
	end if

	'' element lengths must match
	if( src->element_len <> dst->element_len ) then
		return false
	end if

	'' if destination has fixed number of dimensions, it must match source
	if( (fbc.FBARRAY_FLAGS_FIXED_DIM and dst->flags) <> 0 ) then
		if( src->dimensions <> dst->dimensions ) then
			return false
		end if
	end if 

	'' if destination has fixed length, if must match source
	if( (fbc.FBARRAY_FLAGS_FIXED_LEN and dst->flags) <> 0 ) then
		if( src->size <> dst->size ) then
			return false
		end if

	'' otherwise, dynamic destination must uninitialized
	else
		if( dst->base_ptr <> NULL ) then
			return false
		end if

	end if 

	'' allocate memory only if destination is dynamic
	if( (fbc.FBARRAY_FLAGS_FIXED_LEN and dst->flags) = 0 ) then	
		var dataptr = fbc.callocate( src->size )
		'' need a source
		if( dataptr = NULL ) then
			return false
		end if
		dst->base_ptr = dataptr
	end if

	'' copy contents
	fbc.memcopy( dst->base_ptr, src->base_ptr, src->size )
 
	'' finishing setting up the destination descriptor and dimension table
	dst->index_ptr = dst->base_ptr + cunsg(src->index_ptr) - cunsg(src->base_ptr) 
	dst->size = src->size
	dst->element_len = src->element_len
	dst->dimensions = src->dimensions
	
	'' update the dimensions table, 
	'' for fixed length arrays, don't touch the bounds
	for i as integer = 0 to src->dimensions - 1
		if( (fbc.FBARRAY_FLAGS_FIXED_LEN and dst->flags) <> 0 ) then
			dst->dimTb(i).elements = src->dimTb(i).elements
		else
			dst->dimTb(i) = src->dimTb(i)
		end if 	
	next 

	return true
end function

extern "rtlib"
	public function CopyArray _
		( _
			byval dst as fbc.FBARRAY ptr, _
			byval src as fbc.FBARRAY ptr _ 
		) as boolean

		return hCopyArray( dst, src )	
	end function
end extern

#ifdef __FB_DEBUG__
	public sub dumpArrayPtr( byval src as fbc.FBARRAY ptr )
		print "    index_ptr   = "; src->index_ptr
		print "    base_ptr    = "; src->base_ptr
		print "    size        = "; src->size
		print "    element_len = "; src->element_len
		print "    dimensions  = "; src->dimensions
		print "    flags       = "; src->flags
	end sub
#endif

Example:

Code: Select all

extern "rtlib"
	declare function CopyArray( dst() as any, src() as const any ) as boolean
end extern
#inclib "copyarray"

'' source can be dynamic or fixed length
dim a(1 to 10) as integer = {1,2,3,4,5,6,7,8,9,10}

'' EXAMPLE 1
scope
	'' copy to dyanmic array, must be clear, and have same
	'' element length

	redim b() as integer
	
	'' destination must be ready to accept array copy
	erase b
	
	if( CopyArray( b(), a() ) = false ) then
		print "CopyArray failed"
		end 1
	end if
	
	'' modifying the copy only
	for i as integer = lbound(b) to ubound(b)
		b(i) *= 5
	next
	
	'' show results from arrays a and b
	print "a()", "b()"
	for i as integer = lbound(b) to ubound(b)
		print a(i), b(i)
	next
end scope

'' EXAMPLE 2
scope
	'' copy to fixed length array
	'' must have same element length and size, but
	'' bounds can be different

	dim c(11 to 20) as integer
	
	if( CopyArray( c(), a() ) = false ) then
		print "CopyArray failed"
		end 1
	end if
	
	'' modifying the copy only
	for i as integer = lbound(c) to ubound(c)
		c(i) *= 10
	next
	
	'' show results from arrays a and c
	print "a()", "c()"
	for i as integer = lbound(c) to ubound(c)
		print a(i - lbound(c) + lbound(a) ), c(i)
	next
end scope

sleep
Needs more testing. As mentioned, does not handle variable length strings or any other type requiring a constructor, but ZSTRING*N and WSTRING*N should be ok, but not tested.
pidd
Posts: 31
Joined: Nov 11, 2022 16:27

Re: Copy Arrays

Post by pidd »

Thanks

That's my narrow-mindedness sorted then :lol:

I mostly live in a world of integers, strings are annoying things at the best of times especially in this post-ascii world. I have a pressing need to use wstring (I think) and have been burying my head in the sand the last few weeks - so long I've forgotten what I need them for :lol:
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Copy Arrays

Post by dodicat »

This seems to work -- copy a whole array to another.
Fixed on edit.

Code: Select all


#cmdline "-exx"
#include once "fbc-int/array.bi"

Type complex
      As Double re,im
      Dim As String  t
      Declare Constructor
      Declare Constructor(As Double,As Double,As String)
      Declare Operator Cast() As String
End Type
Constructor complex
End Constructor
Constructor complex(d1 As Double,d2 As Double,s As String)
re=d1
im=d2
t=s
End Constructor
Operator complex.cast() As String
Return Str(re)+","+Str(im)+ Str(t)
End Operator


type alltext
      as string s(any)
end type

'==========================================================
#macro set(datatype)
sub ArrayCopy overload(dest_() As datatype,src_() As datatype)
      dim as datatype ptr dest=fbc.ArrayDescriptorPtr(dest_())-> base_ptr
      dim as datatype ptr src=fbc.ArrayDescriptorPtr(src_())-> base_ptr
      dim as long count=fbc.ArrayDescriptorPtr(src_())-> size
      count\=sizeof(datatype)
       While count
       count-=1 
       *dest=*src
       dest+=1
       src+=1
       Wend
end sub
#endmacro


set(string)
set(complex)
set(alltext)
set(zstring ptr)
'==============================================================

Dim As String g(3,4)={{"1","2","3","4","5"},_
                      {"a","b","c","d","e"},_
                      {"9","8","7","6","5"},_
                      {"z","y","x","w","v"}}

Dim As String s(3,4)

ArrayCopy(s(),g())
Erase g
For r As Long=0 To 3
      For c As Long=0 To 4
            Print s(r,c);
      Next
      Print
Next
Print

Redim As complex c(1 To 2,1 To 3)
Print "original"
For n As Long=1 To 2
      For m As Long=1 To 3
            c(n,m)=complex(Rnd-Rnd,Rnd-Rnd," i (imaginary string part)")
            Print c(n,m)
      Next
      Print
Next

Dim As complex k(1 To 2,1 To 3)

ArrayCopy(k(),c())
erase c
Print "copied"
For n As Long=1 To 2
      For m As Long=1 To 3
            Print k(n,m)
      Next
      Print
Next
Print



dim as alltext a(1 to 5,-1 to 2)

for x as long=1 to 5
      for y as long=-1 to 2
            redim (a(x,y).s)(1 to 2)
            a(x,y).s(1)=chr(97+x+y)
            a(x,y).s(2)=chr(97-32+x+y)
            print a(x,y).s(1);" ";a(x,y).s(2);" ";
      next
      print
next
print
print"copied"
dim as alltext n(1 to 5,-1 to 2)

ArrayCopy(n(),a())
  erase a
  for x as long=1 to 5
      for y as long=-1 to 2
             print n(x,y).s(1);" ";n(x,y).s(2);" ";
      next
      print 
next
print
dim as zstring ptr p(...)={strptr("Goodbye"),strptr("Press any key to end . . .")}
dim as zstring ptr q(1)
ArrayCopy(q(),p())
print "'";*q(0);"'"
print "'";*q(1);"'"
Sleep

 
Last edited by dodicat on Jan 08, 2023 1:44, edited 1 time in total.
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Copy Arrays

Post by fxm »

Does not work for an array of strings (copying the string descriptors is not the solution).
After copying, erase the source array and see the result:

Code: Select all

.....
copy(s,g)
erase g
.....
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Copy Arrays

Post by dodicat »

True fxm, var length string array is out via the pointers method.
As an exercise (for my right index finger), I put forward an old fashioned solution.

Code: Select all


#macro set(datatype)
Sub copy Overload(dest() As datatype,src() As datatype)
Var d=Ubound(src,0)'(dimension)
Select Case d
Case 1
    redim dest(Lbound(src,1) To Ubound(src,1))
    For n As Long=Lbound(src,1) To Ubound(src,1)
        dest(n)=src(n)
     Next   
Case 2
    redim dest(Lbound(src,1) To Ubound(src,1),_
               Lbound(src,2) To Ubound(src,2))
For a As Long=Lbound(src,1) To Ubound(src,1)
    For b As Long=Lbound(src,2) To Ubound(src,2)
        dest(a,b)=src(a,b)
    Next:Next
Case 3
    redim dest(Lbound(src,1) To Ubound(src,1),_
               Lbound(src,2) To Ubound(src,2),_
               Lbound(src,3) To Ubound(src,3))
For a As Long=Lbound(src,1) To Ubound(src,1)
    For b As Long=Lbound(src,2) To Ubound(src,2)
       For c As Long=Lbound(src,3) To Ubound(src,3)  
        dest(a,b,c)=src(a,b,c)
    Next:Next:Next
Case 4
    redim dest(Lbound(src,1) To Ubound(src,1),_
               Lbound(src,2) To Ubound(src,2),_
               Lbound(src,3) To Ubound(src,3),_
               Lbound(src,4) To Ubound(src,4))
For a As Long=Lbound(src,1) To Ubound(src,1)
    For b As Long=Lbound(src,2) To Ubound(src,2)
       For c As Long=Lbound(src,3) To Ubound(src,3)
           For d As Long=Lbound(src,4) To Ubound(src,4)
        dest(a,b,c,d)=src(a,b,c,d)
    Next:Next:Next:Next
Case 5
    redim dest(Lbound(src,1) To Ubound(src,1),_
               Lbound(src,2) To Ubound(src,2),_
               Lbound(src,3) To Ubound(src,3),_
               Lbound(src,4) To Ubound(src,4),_
               Lbound(src,5) To Ubound(src,5))
For a As Long=Lbound(src,1) To Ubound(src,1)
    For b As Long=Lbound(src,2) To Ubound(src,2)
       For c As Long=Lbound(src,3) To Ubound(src,3)
           For d As Long=Lbound(src,4) To Ubound(src,4)
               For e As Long=Lbound(src,5) To Ubound(src,5)
        dest(a,b,c,d,e)=src(a,b,c,d,e)
    Next:Next:Next:Next:Next 
case 6
    redim dest(Lbound(src,1) To Ubound(src,1),_
               Lbound(src,2) To Ubound(src,2),_
               Lbound(src,3) To Ubound(src,3),_
               Lbound(src,4) To Ubound(src,4),_
               Lbound(src,5) To Ubound(src,5),_
               Lbound(src,6) To Ubound(src,6))
  For a As Long=Lbound(src,1) To Ubound(src,1)
    For b As Long=Lbound(src,2) To Ubound(src,2)
       For c As Long=Lbound(src,3) To Ubound(src,3)
           For d As Long=Lbound(src,4) To Ubound(src,4)
               For e As Long=Lbound(src,5) To Ubound(src,5)
                    For f As Long=Lbound(src,6) To Ubound(src,6)
        dest(a,b,c,d,e,f)=src(a,b,c,d,e,f)
    Next:Next:Next:Next:Next:Next  
    
  ' to dim 8 if needed 
    
End Select

End Sub
#endmacro

#macro cpy(dest,src,flag)
#if flag
set(typeof(src))
#endif
copy(dest(),src())
#endmacro

Dim As String g(3,4)={{"1","2","3","4","5"},_
                      {"a","b","c","d","e"},_
                      {"9","8","7","6","5"},_
                      {"z","y","x","w","v"}}

Dim As String s()

cpy(s,g,1)

'Erase(g)
For r As Long=0 To 3
    For c As Long=0 To 4
        Print s(r,c);
    Next
    Print
Next
Print


Type complex
    As Double re,im
    dim as string t
    declare constructor
    declare constructor(as double,as double,as string)
    declare operator cast() as string
End Type
constructor complex
end constructor
constructor complex(d1 as double,d2 as double,s as string)
re=d1
im=d2
t=s
end constructor
operator complex.cast() as string
return str(re)+","+str(im)+ str(t)
end operator


Redim As complex c(1 To 2,1 To 3)

Print "original"
For n As Long=1 To 2
    For m As Long=1 To 3
        c(n,m)=complex(Rnd-Rnd,Rnd-Rnd," i")
        Print c(n,m)
    Next
    Print
Next

Dim As complex k()

cpy(k,c,1)

Print "copied"
For n As Long=1 To 2
    For m As Long=1 To 3
        print k(n,m)
    Next
    Print
Next
Print

dim as any ptr p(...)={@s(0),@k(1,1)}

redim as any ptr q()

cpy(q,p,1)
print p(0),p(1)
print q(0),q(1)
print
dim as string z(1 to 3)={"hello","goobbye","Press any key to end"}
dim as string w()
cpy(w,z,0)
for n as long=1 to 3
    print w(n)
    next

sleep

 
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Copy Arrays

Post by fxm »

In the following code, the data type of the two arrays can be any type, but the only constraint is that the destination array must be an array declared dynamic (declared without dimensions, or with the same number of dimensions as the source array).
If the type is a composed type name (like 'Integer Ptr'), an alias must be defined (like 'Type myType As Integer Ptr') for the macro parameter.

Code: Select all

#macro arraycopy(dst, src, datatype)
    #include once "fbc-int/array.bi"
    #ifndef existUDT##datatype
        #define existUDT##datatype
        Namespace FXM
            Type UDT##datatype
                Dim As datatype array(Any, Any, Any, Any, Any, Any, Any, Any)
            End Type
        End Namespace
    #endif
    Scope
        Dim As FXM.UDT##datatype Ptr ps = Cptr(FXM.UDT##datatype Ptr, FBC.ArrayDescriptorPtr(src()))
        Dim As FXM.UDT##datatype Ptr pd = Cptr(FXM.UDT##datatype Ptr, FBC.ArrayDescriptorPtr(dst()))
        *pd = *ps
    End Scope
#endmacro

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

Dim As String s1(3), d1()
s1(0) = "a"
s1(1) = "b"
s1(2) = "c"
s1(3) = "d"

arraycopy(d1, s1, string)

For I As Integer = Lbound(d1) To Ubound(d1)
    Print "'" & d1(I) & "'",
Next I
Print

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

Dim As Zstring Ptr s2(), d2(Any)
Redim s2(3)
s2(0) = @"e"
s2(1) = @"f"
s2(2) = @"g"
s2(3) = @"h"

Type myType As Zstring Ptr
arraycopy(d2, s2, myType)

For I As Integer = Lbound(d2) To Ubound(d2)
    Print "'" & *d2(I) & "'",
Next I
Print

Sleep


Edit]
Currently does not work with a dynamic 'String * N' array, but because of a bug for a UDT having such a field.
(see BUG - UDT does not work correctly with a dynamic 'String * N' array as field)
Last edited by fxm on Jan 08, 2023 10:07, edited 1 time in total.
Reason: Updated
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Copy Arrays

Post by dodicat »

Hi fxm.
Nice neat method.
In my not too neat pedantic no pointers method I can create the overloads in the main module.
e.g.
set(string)
set(zstring ptr)
Then I can use copy() inside any scoped block or the main module.
i.e. I don't have to use the cpy macro (where it wouldn't be allowed anyway).
Maybe you should consider something similar to be able to copy arrays inside subs or loops or any other scoped block.
(Just a thought)
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Copy Arrays

Post by fxm »

In my macro 'arraycopy()' above, the UDT structure defined there cannot be placed in a scoped block (because it includes constructors, operators, destructor, added implicitly by the compiler).
One solution is to split this macro into two macros:
- a macro to define the type of data of the array to be copied (to be put in the main code),
- another macro to copy the array (to put anywhere).

Code: Select all

#macro arraydefine(datatype)
    #include once "fbc-int/array.bi"
    #ifndef existUDT##datatype
        #define existUDT##datatype
        Namespace FXM
            Type UDT##datatype
                Dim As datatype array(Any, Any, Any, Any, Any, Any, Any, Any)
            End Type
        End Namespace
    #endif
#endmacro

#macro arraycopy(dst, src, datatype)
    Scope
        Dim As FXM.UDT##datatype Ptr ps = Cptr(FXM.UDT##datatype Ptr, FBC.ArrayDescriptorPtr(src()))
        Dim As FXM.UDT##datatype Ptr pd = Cptr(FXM.UDT##datatype Ptr, FBC.ArrayDescriptorPtr(dst()))
        *pd = *ps
    End Scope
#endmacro

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

Dim As String s1(3)
s1(0) = "a"
s1(1) = "b"
s1(2) = "c"
s1(3) = "d"

Dim As String d1()
arraydefine(string)

Scope
    arraycopy(d1, s1, string)
    
    For I As Integer = Lbound(d1) To Ubound(d1)
        Print "'" & d1(I) & "'",
    Next I
    Print
End Scope

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

Dim As Zstring Ptr s2()
Redim s2(3)
s2(0) = @"e"
s2(1) = @"f"
s2(2) = @"g"
s2(3) = @"h"

Dim As Zstring Ptr d2(Any)
Type myType2 As Zstring Ptr
arraydefine(myType2)

Scope
    arraycopy(d2, s2, myType2)
    
    For I As Integer = Lbound(d2) To Ubound(d2)
        Print "'" & *d2(I) & "'",
    Next I
    Print
End scope

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

Dim As Zstring * 2 s3()
Redim s3(3)
s3(0) = "i"
s3(1) = "j"
s3(2) = "k"
s3(3) = "l"

Dim As Zstring * 2 d3()
Redim d3(0)
Type myType3 As Zstring * 2
arraydefine(myType3)

Scope
    arraycopy(d3, s3, myType3)
    
    For I As Integer = Lbound(s3) To Ubound(s3)
        Print "'" & s3(I) & "'",
    Next I
    Print
End scope

Sleep


Edit]
Currently does not work with a dynamic 'String * N' array, but because of a bug for a UDT having such a field.
(see BUG - UDT does not work correctly with a dynamic 'String * N' array as field)
Last edited by fxm on Jan 08, 2023 9:43, edited 3 times in total.
Reason: Updated
coderJeff
Site Admin
Posts: 4313
Joined: Nov 04, 2005 14:23
Location: Ontario, Canada
Contact:

Re: Copy Arrays

Post by coderJeff »

fxm, dodicat, neato. I think is good approach letting fbc handle the assignment as it would give consistent results for all arrays with normal user code (and unlike what I wrote, doesn't require some new procedure full of funky operations that have to be tested separately).

A couple of users have in the past asked for something that would deal with the type names:
- something like GetMangledTypeName( integer ptr ) that would return something like "INTEGER_PTR" that can be used as single token identifier for that type. Maybe something to try that could be added to `__fb_query_symbol__` thing (if we ever get back to it). Still kind of hack-ish but maybe still a slight improvement. idk.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Copy Arrays

Post by dodicat »

fxm wrote: Jan 07, 2023 6:05 In my macro 'arraycopy()' above, the UDT structure defined there cannot be placed in a scoped block (because it includes constructors, operators, destructor, added implicitly by the compiler).
One solution is to split this macro into two macros:
- a macro to define the type of data of the array to be copied (to be put in the main code),
- another macro to copy the array (to put anywhere).
...
...
Edit]
Currently does not work with a dynamic 'String * N' array, but because of a bug for a UDT having such a field.
(see BUG - UDT does not work correctly with a dynamic 'String * N' array as field)
Agreed, fixed length string dynamic arrays in a UDT do not readily copy in other methods also.
Another ArrayCopy using traditional methods and the traditional pointers to array data.

Code: Select all

#cmdline "-exx"
'======================================================================
#macro set(datatype)
Sub ArrayCopy Overload(Dest() As datatype,Src() As datatype)
      #macro GetSize(array,d)
      d=Ubound(array,0)
      For n As Integer=1 To d
            If n=1 Then d=1
            d=d*(Ubound(array,n)-Lbound(array,n)+1)
      Next
      d=d*Sizeof(array)
      #endmacro
      #define sl(n) (Lbound(Src,n))
      #define dl(n) (Lbound(Dest,n))
      #define su(n) (Ubound(Src,n))
      Dim As Long count
      getsize(Src,count)
      count\=Sizeof(datatype)
      Dim As datatype Ptr sp,dp
      Select Case Ubound(Src,0)
      Case 1
            Redim Dest(sl(1) To su(1))
            sp=@Src(sl(1))
            dp=@Dest(dl(1))
      Case 2
            Redim Dest(sl(1) To su(1),sl(2) To su(2))
            sp=@Src(sl(1),sl(2))
            dp=@Dest(dl(1),dl(2))
      Case 3
            Redim Dest(sl(1) To su(1),sl(2) To su(2),sl(3) To su(3))
            sp=@Src(sl(1),sl(2),sl(3))
            dp=@Dest(dl(1),dl(2),dl(3))
      Case 4
            Redim Dest(sl(1) To su(1),sl(2) To su(2),sl(3) To su(3),sl(4) To su(4))
            sp=@Src(sl(1),sl(2),sl(3),sl(4))
            dp=@Dest(dl(1),dl(2),dl(3),dl(4))
      Case 5
            Redim Dest(sl(1) To su(1),sl(2) To su(2),sl(3) To su(3),sl(4) To su(4),sl(5) To su(5))
            sp=@Src(sl(1),sl(2),sl(3),sl(4),sl(5))
            dp=@Dest(dl(1),dl(2),dl(3),dl(4),dl(5))
      case 6
            Redim Dest(sl(1) To su(1),sl(2) To su(2),sl(3) To su(3),sl(4) To su(4),sl(5) To su(5),_
            sl(6) To su(6))
            sp=@Src(sl(1),sl(2),sl(3),sl(4),sl(5),sl(6))
            dp=@Dest(dl(1),dl(2),dl(3),dl(4),dl(5),dl(6))
      case 7
            Redim Dest(sl(1) To su(1),sl(2) To su(2),sl(3) To su(3),sl(4) To su(4),sl(5) To su(5),_
            sl(6) To su(6),sl(7) to su(7))
            sp=@Src(sl(1),sl(2),sl(3),sl(4),sl(5),sl(6),sl(7))
            dp=@Dest(dl(1),dl(2),dl(3),dl(4),dl(5),dl(6),dl(7))
      case 8
            Redim Dest(sl(1) To su(1),sl(2) To su(2),sl(3) To su(3),sl(4) To su(4),sl(5) To su(5),_
            sl(6) To su(6),sl(7) to su(7),sl(8) to su(8))
            sp=@Src(sl(1),sl(2),sl(3),sl(4),sl(5),sl(6),sl(7),sl(8))
            dp=@Dest(dl(1),dl(2),dl(3),dl(4),dl(5),dl(6),dl(7),dl(8))
            
      End Select
      While count
            count-=1 
            *dp=*sp
            dp+=1
            sp+=1
      Wend
End Sub
#endmacro
'=========================================================================

type alltext
      as string s(any)
end type

union colour
      as ulong c
      type
      as byte b,g,r,a
end type
end union


set(String)
set(alltext)
set(colour)
set(zstring ptr)

Dim As String g(3,4)={{"1","2","3","4","5"},_
                      {"a","b","c","d","e"},_
                      {"9","8","7","6","5"},_
                      {"z","y","x","w","v"}}

Dim As String s()

ArrayCopy(s(),g())
Erase g 'optional
print "copied 2D string array"
For r As Long=0 To 3
      For c As Long=0 To 4
            print s(r,c);
      Next
      Print
Next
Print

dim as alltext a(1 to 5,-1 to 2)
print "original 2D udt array with dynamic string array field"
for x as long=1 to 5
      for y as long=-1 to 2
            redim (a(x,y).s)(1 to 2)
            a(x,y).s(1)=chr(97+x+y)
            a(x,y).s(2)=chr(97-32+x+y)
            print a(x,y).s(1);" ";a(x,y).s(2);" ";
      next
      print
next
print
print"copied"
dim as alltext n()

ArrayCopy(n(),a())
  erase a 'optional
  for x as long=lbound(n,1) to ubound(n,1)
      for y as long=lbound(n,2) to ubound(n,2)
             print n(x,y).s(1);" ";n(x,y).s(2);" ";
      next
      print 
next
print

dim as colour x(1 to 1,2 to 2,3 to 3)
x(1,2,3).c=rgba(1,2,3,4)

dim as colour y()
ArrayCopy(y(),x())
erase x 'optional
print "copied union"
print "rgba(";y(1,2,3).r;",";y(1,2,3).g;",";y(1,2,3).b;",";y(1,2,3).a;")"

print
dim as zstring ptr p(...)={strptr("Goodbye zstring ptr"),strptr("Press any key to end . . .")}
dim as zstring ptr q()
ArrayCopy(q(),p())
print "'";*q(0);"'"
print "'";*q(1);"'"
sleep 
Post Reply