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)