Rect_t - optimized type definition

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Rect_t - optimized type definition

Post by dodicat »

Thanks Mr Swiss.
I am fed up now of trying to get a rectangle in one byte or less.
I'll try another day not too soon.
In the meantime a full blown mega Monte.

Code: Select all

Type point 
    As short x,y
    Declare Constructor(As short=0,As short=0)
End Type

Declare Function shortline(fp As point,p As point,length As Long) As point

Constructor point(xx As short=0,yy As short=0)
x=xx
y=yy
End Constructor

Type Rectangle Extends point
    As ushort wide
    As ushort high
    As Single aspect
    as byte pflag
    as ulong clr
    Declare  Constructor(As point=point(0,0),As ushort=0,As ushort=0,As Single =0,as ulong=0,as byte=0)
    As point v(1 To 4)
End Type

Constructor rectangle(c As point,w As ushort,h As ushort,a As Single,col as ulong,pf as byte)
#macro rotate(pivot,p,a,d)
point(d*(Cos(a*.0174533)*(p.x-pivot.x)-Sin(a*.0174533)*(p.y-pivot.y)) +pivot.x,_
d*(Sin(a*.0174533)*(p.x-pivot.x)+Cos(a*.0174533)*(p.y-pivot.y)) +pivot.y)
#endmacro
v(1)=Type(c.x-w/2,c.y-h/2)
v(2)=Type(c.x-w/2,c.y+h/2)
v(3)=Type(c.x+w/2,c.y+h/2)
v(4)=Type(c.x+w/2,c.y-h/2)
For n As Long=1 To 4
    v(n)=rotate(c,v(n),a,1)
Next
pflag=pf
clr=col
End Constructor

Type RoundedRectangle Extends Rectangle
    As ushort rad
    Declare Sub Draw() 
    Declare Constructor( As point=Type(0,0), As ushort=0, As ushort=0, As Single=0,As ushort=0,as ulong=0,as byte=0)
End Type

Constructor roundedrectangle(c As point,w As ushort,h As ushort,a As Single,r As ushort,col as ulong,pf as byte)
This=*Cast(roundedrectangle Ptr,@rectangle(c,w,h,a,col,pf))
#define mn iif(w>h,h/2,w/2)
rad=Iif (r>mn,mn,r)
End Constructor

Sub roundedrectangle.draw()
    dim as ubyte r=cast(ubyte ptr,@clr)[2],g=cast(ubyte ptr,@clr)[1]
    dim as ubyte b=cast(ubyte ptr,@clr)[0],a=cast(ubyte ptr,@clr)[3]
    dim as ulong c1=rgba(r,g,b,255)
    Dim As Long q
    #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
    
    #macro set(dx,dy,z)
    z=Atan2(dy,dx)
    If dx<=0 And dy<=0 Then q=3
    If dx>=0 And dy<=0 Then q=4
    Select Case as const q
    Case 3,4:z=map(-pi,0,z,pi,2*pi)
    End Select
    #endmacro
    
    Const pi=4*Atn(1)
    Dim As Single s,e,dx,dy
    Dim As point t(1 To 8),c(1 To 4)
    t(1)=shortline(v(1),v(2),rad)
    t(2)=shortline(v(2),v(1),rad)
    Line(t(1).x,t(1).y)-(t(2).x,t(2).y),c1
    
    t(3)=shortline(v(2),v(3),rad)
    t(4)=shortline(v(3),v(2),rad)
    Line(t(3).x,t(3).y)-(t(4).x,t(4).y),c1
    
    t(5)=shortline(v(3),v(4),rad)
    t(6)=shortline(v(4),v(3),rad)
    Line(t(5).x,t(5).y)-(t(6).x,t(6).y),c1
    
    t(7)=shortline(v(4),v(1),rad)
    t(8)=shortline(v(1),v(4),rad)
    Line(t(7).x,t(7).y)-(t(8).x,t(8).y),c1
    
    c(1)=shortline(t(1),t(6),rad)
    dy=t(8).y-c(1).y:dx=t(8).x-c(1).x
    set(dx,-dy,s)
    dy=t(1).y-c(1).y:dx=t(1).x-c(1).x
    set(dx,-dy,e)
    Circle(c(1).x,c(1).y),rad,c1,s,e
    
    c(2)=shortline(t(2),t(5),rad)
    dx=t(2).x-c(2).x:dy=t(2).y-c(2).y
    set(dx,-dy,s)
    dx=t(3).x-c(2).x:dy=t(3).y-c(2).y
    set(dx,-dy,e)
    Circle(c(2).x,c(2).y),rad,c1,s,e
    
    c(3)=shortline(t(4),t(7),rad)
    dx=t(4).x-c(3).x:dy=t(4).y-c(3).y
    set(dx,-dy,s)
    dx=t(5).x-c(3).x:dy=t(5).y-c(3).y
    set(dx,-dy,e)
    Circle(c(3).x,c(3).y),rad,c1,s,e
    
    c(4)=shortline(t(6),t(1),rad)
    dx=t(6).x-c(4).x:dy=t(6).y-c(4).y
    set(dx,-dy,s)
    dx=t(7).x-c(4).x:dy=t(7).y-c(4).y
    set(dx,-dy,e)
    Circle(c(4).x,c(4).y),rad,c1,s,e
    
   if pflag then paint((c(1).x+c(3).x)\2,(c(1).y+c(3).y)\2),clr,c1
End Sub

Function shortline(fp As point,p As point,length As Long) As point
    Dim As long diffx=p.x-fp.x,diffy=p.y-fp.y
    Dim As single L=Sqr(diffx*diffx+diffy*diffy)
    Return Type(fp.x+length*diffx/L,fp.y+length*diffy/L)
End Function

''========================================
Screen 19,32,,64
dim as roundedrectangle ra(1 to 20)
dim as byte b=1
do
    b=-b
    cls
    for n as long=lbound(ra) to ubound(ra)
        dim as short x=rnd*700
        dim as short y=rnd*600
        dim as ushort w=5+rnd*200
        dim as ushort h=5+rnd*200
        dim as single ang=rnd*360
        dim as ushort r=5+rnd*25
        dim as ulong clr=rgba(rnd*255,rnd*255,rnd*255,100+rnd*155)
        dim as byte fill=1-b
      ra(n)=roundedrectangle(point(x,y),w,h,ang,r,clr,fill)
      ra(n).draw
    next n
    sleep
    loop until inkey=chr(27)

   
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Rect_t - optimized type definition

Post by paul doe »

MrSwiss wrote:Btw. struct/type packing in FBC, is done depending on the "lagest sized variable", inside
the struct/type and, doesn't follow any other rules (AFAIR, as in FB-doc stated).
No. It depends on the order of the members:

Code: Select all

type AType
  var1 as long   ''  4 bytes
  var2 as short  ''  2 bytes
  var3 as ubyte  ''  1 byte
end type  '' total:  7 bytes

type AnotherType
  var1 as ubyte ''  1 byte
  var2 as long  ''  4 bytes
  var3 as short ''  2 bytes
end type  '' total: 7 bytes

? sizeOf( AType )       '' 8
? sizeOf( AnotherType ) '' 12

sleep()
The reasons are alignment and padding. See this post for an in-depth explanation. The post in Stack Overflow is about C++, but the same concept also applies for FreeBasic.
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Rect_t - optimized type definition

Post by MrSwiss »

paul doe wrote:No. It depends on the order of the members
This is not quite true, if one knows, how to avoid padding inbetween members
(except, at the very end of a type).
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Rect_t - optimized type definition

Post by paul doe »

MrSwiss wrote:This is not quite true, if one knows, how to avoid padding inbetween members
(except, at the very end of a type).
Sorry, but you said:
MrSwiss wrote:Btw. struct/type packing in FBC, is done depending on the "lagest sized variable", inside
the struct/type and, doesn't follow any other rules (AFAIR, as in FB-doc stated).
Which is the part I was responding to. Packing a structure doesn't have anything to do with aligning it:

Code: Select all

type AType field = 1
  var1 as long   ''  4 bytes
  var2 as short  ''  2 bytes
  var3 as ubyte  ''  1 byte
end type  '' total:  7 bytes

type AnotherType field = 1
  var1 as ubyte ''  1 byte
  var2 as long  ''  4 bytes
  var3 as short ''  2 bytes
end type  '' total: 7 bytes

? sizeOf( AType )       '' 7
? sizeOf( AnotherType ) '' 7

sleep()
This gives the expected results, but the structure is not aligned anymore. If you don't pack the structure, you simply can't tell the compiler to not align the structure's members. The best you can do is to tell it the alignment boundary (1, 2 or 4 bytes).
So, to achieve the best possible structure size, you have to consider the order in which you put its members, to get the best possible alignment.
Last edited by paul doe on Aug 15, 2018 19:33, edited 4 times in total.
fxm
Moderator
Posts: 12083
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Rect_t - optimized type definition

Post by fxm »

paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Rect_t - optimized type definition

Post by paul doe »

fxm wrote:See also at Structure packing/field alignment.
Thanks, fxm. I have to get accustomed to look at the Wiki first =D
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Rect_t - optimized type definition

Post by dodicat »

In an image pointer there are three reserved spaces:
[5],[6] and [7]
These can be used to store the x,y co-ordinates of a rectangle position and the fill option.
So all the information aforementioned as being required in a type can stored in the image, thus within the type.

Code: Select all


type rectangle
    as any ptr i
    declare function create(as long=0,as long=0,as ulong=rgb(255,0,255),as ulong=0) byref as any ptr
    declare sub info
end type

function rectangle.create(x as long,y as long,c as ulong,fill as ulong=0) byref as any ptr
    dim as integer w,h
    if i then w=cast(ulong ptr,i)[2]:h=cast(ulong ptr,i)[3]
    if fill then line i,(0,0)-(w-1,h-1),c,bf else line i,(0,0)-(w-1,h-1),c,b
    if i then put (x,y),i,alpha,cast(ubyte ptr,@c)[3]
    if i then cast(long ptr,i)[5]=x:cast(long ptr,i)[6]=y:cast(ulong ptr,i)[7]=fill
    function= i
end function

sub rectangle.info
   dim as ulong clr=cast(ulong ptr,i)[8]
    print "Width  ";cast(ulong ptr,i)[2]
    print "Height ";cast(ulong ptr,i)[3]
    print "X pos  ";cast(long ptr,i)[5]
    print "Y pos  ";cast(long ptr,i)[6]
    print "Fill   ";cast(ulong ptr,i)[7]
    print "Colour RGBA (";cast(ubyte ptr,@clr)[2];",";
    print                 cast(ubyte ptr,@clr)[1];",";
    print                 cast(ubyte ptr,@clr)[0];",";
    print                 cast(ubyte ptr,@clr)[3];")"
end sub
'===========================================================

screen 19,32

dim as rectangle r
r.create=imagecreate(200,300)
r.create(250,50,rgba(12,56,200,100),1)
locate 7
r.info
'_______________
dim as rectangle r2
r2.create=imagecreate(400,50)
r2.create(300,500,rgb(0,220,0))
locate 28
r2.info
print "press a key"
sleep
dim as rectangle z(1 to 20)
dim as byte b=1
do
    cls
    b=-b
    for n as long=1 to ubound(z)
        z(n).create=imagecreate(10+rnd*400,10+rnd*400)
        z(n).create(rnd*800-rnd*200,rnd*600-rnd*100,rgba(rnd*255,rnd*255,rnd*255,100+rnd*255),1-b)
        imagedestroy(z(n).i):z(n).i=0
    next n
    sleep
loop until inkey=chr(27)
imagedestroy r.i
imagedestroy r2.i
        
        


   
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Rect_t - optimized type definition

Post by dodicat »

4 byte rectangle.

Code: Select all

 
Type rectangle 
  Declare Function f(As Long) Byref As rectangle
  As Ulong x
End Type

Sub create(R As rectangle,x1 As Long,y1 As Long,x2 As Long,y2 As Long,clr As Ulong,fill As Long)
  R.x=x1
  R.f(1).x=y1
  R.f(1).f(2).x=x2
  R.f(1).f(2).f(3).x=y2
  R.f(1).f(2).f(3).f(4).x=clr
  R.f(1).f(2).f(3).f(4).f(5).x=fill
End Sub

Sub show(R As rectangle)
  If R.f(1).f(2).f(3).f(4).f(5).x Then  'fill
    Line(R.x,R.f(1).x)-(R.f(1).f(2).x,R.f(1).f(2).f(3).x),R.f(1).f(2).f(3).f(4).x,bf
  Else
    Line(R.x,R.f(1).x)-(R.f(1).f(2).x,R.f(1).f(2).f(3).x),R.f(1).f(2).f(3).f(4).x,b
  End If
End Sub

Function rectangle.f(x As Long) Byref As rectangle
  Static As rectangle u(1 To 5)
  Return u(x)
End Function

Sub printvalues(R As rectangle)
  Dim As Ulong fill=R.f(1).f(2).f(3).f(4).f(5).x
  Dim As Ulong c=R.f(1).f(2).f(3).f(4).x
  Print R.x;","; _
  R.f(1).x;","; _
  R.f(1).f(2).x;","; _
  R.f(1).f(2).f(3).x;","; _
  " rgb(";Cptr(Ubyte Ptr,@c)[2];",";Cptr(Ubyte Ptr,@c)[1];",";Cptr(Ubyte Ptr,@c)[0];",";Cptr(Ubyte Ptr,@c)[3];")";
  Print Iif(fill," (Fill)","")
  Print
End Sub


Randomize 
Screen 20,32,,64
Dim As rectangle u
Do
  Cls
  For n As Long=1 To 5
    Dim As Ulong c=Rgba(Rnd*255,Rnd*255,Rnd*255,200+Rnd*55)
    create(u,Rnd*1024,200+Rnd*568,Rnd*1024,200+Rnd*568,c,Rnd>.5)
    show(u)
    Color c
    printvalues(u)
  Next
  Sleep
Loop Until Inkey=Chr(27)

Sleep


 
Post Reply