Jump to content
LordJashin

OSI, Box.scar new functions from MSSL

By LordJashin, in OSI Updates

Recommended Posts

LordJashin God Member

LordJashin

Posted
Posted

New functions: - https://github.com/OSI1/OSI1/blob/master/Divi/Box.scar

 

Janilabo gets all the credit for making these! But I did change one or two I think a little bit. Thanks Jani!

 

[scar]

{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

Official SCAR Include

Box Routines

--------------------------------------------------------------------------------

* procedure ClearBox(var bx: TBox);

* procedure FixBox(var bx: TBox);

* function BoxInBox(inner_bx, outer_bx: TBox): Boolean;

* function ValidBox(bx: TBox): Boolean;

* function SameBoxes(bx1, bx2: TBox): Boolean;

* function BoxCenter(bx: TBox): TPoint;

* procedure ExpandBox(var bx: TBox; eSize: Integer);

* procedure ShrinkBox(var bx: TBox; sSize: Integer);

* procedure ResizeBox(var bx: TBox; pixels, method: Integer);

* procedure OffsetBox(var bx: TBox; xOffset, yOffset: Integer);

* procedure BoxDimensions(bx: TBox; var w, h: Integer);

* procedure BoxCentralization(var inner_bx: TBox; outer_bx: TBox; method: Integer);

* function TBABounds(TBA: TBoxArray): TBox;

* function TBASame(TBA1, TBA2: TBoxArray): Boolean;

* procedure TBAInsert(var TBA: TBoxArray; index: Integer; bx: TBox);

* procedure TBAUnique(var TBA: TBoxArray);

* function TBADelete(var TBA: TBoxArray; x: Integer): Boolean;

* procedure TBARandomize(var TBA: TBoxArray);

* procedure TBAClear(var TBA: TBoxArray; IDs: TIntArray);

* function TBAContains(TBA: TBoxArray; bx: TBox): Boolean;

* function TBAPositions(TBA: TBoxArray; bx: TBox): TIntArray;

* function TBAAllValuesSame(TBA: TBoxArray): Boolean;

* function TBAAllValuesUnique(TBA: TBoxArray): Boolean;

=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

[/scar]

 

Decided to get this bad boy first. I still haven't figured out though what do these do exactly?:

 

function MSSL_SetBoxConstraints(var bx: TBox; size: TBox): Boolean;

procedure MSSL_TBASkipBoxesByArea(var TBA: TBoxArray; skipArea: TBox; fromInside: Boolean);

procedure MSSL_TBASkipBoxesByAreas(var TBA: TBoxArray; skipAreas: TBoxArray; fromInside: Boolean);

function MSSL_TBAToATBAByPartSize(TBA: TBoxArray; partSize: Integer): T2DBoxArray;

function MSSL_TBAToATBAByPartAmount(TBA: TBoxArray; amount: Integer): T2DBoxArray;

 

[scar]

function MSSL_SetBoxConstraints(var bx: TBox; size: TBox): Boolean;

{==============================================================================|

Created: September 30th, 2012.

Contributors: Janilabo

Explanation: Set minimum / maximum size to bx.

size.X1 = min. X1, size.Y1 = min. Y1, size.X2 = max. X2, size.Y2 = max. Y2

[==============================================================================}

var

tmp: TBox;

begin

tmp := bx;

if ((size.X1 > size.X2) or (size.Y1 > size.Y2)) then

Exit;

if (bx.X1 < size.X1) then

bx.X1 := size.X1;

if (bx.Y1 < size.Y1) then

bx.Y1 := size.Y1;

if (bx.X2 > size.X2) then

bx.X2 := size.X2;

if (bx.Y2 > size.Y2) then

bx.Y2 := size.Y2;

Result := (bx <> tmp);

end;

 

procedure MSSL_TBASkipBoxesByArea(var TBA: TBoxArray; skipArea: TBox; fromInside: Boolean);

{==============================================================================|

Created: September 30th, 2012.

Contributors: Janilabo

Explanation:

[==============================================================================}

var

i, h, t: Integer;

tmpArr: TBoxArray;

sb: Boolean;

begin

h := High(TBA);

SetLength(tmpArr, (h + 1));

for i := 0 to h do

begin

case fromInside of

True: sb := ((TBA.x1 >= skipArea.x1) and (TBA.y1 >= skipArea.y1) and

(TBA.x2 <= skipArea.x2) and (TBA.y2 <= skipArea.y2));

False: sb := ((TBA.x2 >= skipArea.x1) and (TBA.x2 <= skipArea.x2) and

(TBA.y2 >= skipArea.y1) and (TBA.y2 <= skipArea.y2) or

(TBA.x1 <= skipArea.x2) and (TBA.x1 >= skipArea.x1) and

(TBA.y1 <= skipArea.y2) and (TBA.y1 >= skipArea.y1));

end;

if not sb then

begin

tmpArr[t] := TBA;

Inc(t);

end;

end;

SetLength(tmpArr, t);

SetLength(TBA, 0);

TBA := tmpArr;

SetLength(tmpArr, 0);

end;

 

procedure MSSL_TBASkipBoxesByAreas(var TBA: TBoxArray; skipAreas: TBoxArray; fromInside: Boolean);

{==============================================================================|

Created: September 30th, 2012.

Contributors: Janilabo

Explanation:

[==============================================================================}

var

i, h, i2, h2, t: Integer;

tmpArr: TBoxArray;

sb: Boolean;

begin

h := High(TBA);

SetLength(tmpArr, (h + 1));

h2 := High(skipAreas);

for i := 0 to h do

begin

for i2 := 0 to h2 do

begin

case fromInside of

True: sb := ((TBA.x1 >= skipAreas[i2].x1) and (TBA.y1 >= skipAreas[i2].y1) and

(TBA.x2 <= skipAreas[i2].x2) and (TBA.y2 <= skipAreas[i2].y2));

False: sb := ((TBA.x2 >= skipAreas[i2].x1) and (TBA.x2 <= skipAreas[i2].x2) and

(TBA.y2 >= skipAreas[i2].y1) and (TBA.y2 <= skipAreas[i2].y2) or

(TBA.x1 <= skipAreas[i2].x2) and (TBA.x1 >= skipAreas[i2].x1) and

(TBA.y1 <= skipAreas[i2].y2) and (TBA.y1 >= skipAreas[i2].y1));

end;

if sb then

Break;

end;

if not sb then

begin

tmpArr[t] := TBA;

Inc(t);

end;

end;

SetLength(tmpArr, t);

SetLength(TBA, 0);

TBA := tmpArr;

SetLength(tmpArr, 0);

end;

function MSSL_TBAToATBAByPartSize(TBA: TBoxArray; partSize: Integer): T2DBoxArray;

{==============================================================================|

Created: September 30th, 2012.

Contributors: Janilabo

Explanation: Breaks TBA to ATBA by part size.

[==============================================================================}

var

i, i2, r, h, d: Integer;

begin

h := High(TBA);

if ((h >= 0) and (partSize > 0)) then

if (partSize <= h) then

begin

Inc(h);

r := (h div partSize);

if ((r * partSize) < h) then

Inc®;

SetLength(Result, r);

for i := 0 to (r - 1) do

for i2 := 0 to (partSize - 1) do

begin

SetLength(Result, partSize);

if (d < h) then

begin

Result[i2] := TBA[d];

Inc(d);

end else

begin

SetLength(Result, i2);

Exit;

end;

end;

end else

Result := [TBA];

end;

 

function MSSL_TBAToATBAByPartAmount(TBA: TBoxArray; amount: Integer): T2DBoxArray;

{==============================================================================|

Created: September 30th, 2012.

Contributors: Janilabo

Explanation: Breaks TBA to ATBA by part amount.

[==============================================================================}

var

p, h, e, i, i2, h2, a: Integer;

begin

h := High(TBA);

if ((h <= 0) or (amount < 2)) then

begin

if (amount = 1) then

Result := [TBA]

else

if (amount > 0) then

SetLength(Result, Amount);

Exit;

end;

if (h < (amount - 1)) then

amount := (h + 1);

p := Floor((h + 1) / amount);

if (p = 0) then

p := 1;

e := ((h + 1) - (p * amount));

if (e >= (h + 1)) then

e := 0;

SetLength(Result, amount);

for i := 0 to (amount - 1) do

begin

if ((e >= (i + 1)) and (e > 0)) then

SetLength(Result, (p + 1))

else

if (i <= h) then

SetLength(Result, p);

h2 := High(Result);

for i2 := 0 to h2 do

begin

Result[i2] := TBA[a];

Inc(a);

end;

end;

end;

[/scar]

Link to comment
Share on other sites
Janilabo Contributing Member

 Janilabo

Posted
Posted (edited)

Nice work, LJ.

 

Anyways, these might help you out:

TSAToATSAByPartAmount

TSAToATSAByPartSize

^--Although, I just noticed I could combine those 2 functions together. :)

Edit: COMBINED

 

Also, example to SetBoxConstraints:

 

function SetBoxConstraints(var bx: TBox; size: TBox): Boolean; // Returns true if constrains were set to bx.
var
 tmp: TBox;
begin
 tmp := bx;
 if ((size.X1 > size.X2) or (size.Y1 > size.Y2)) then
   Exit;
 if (bx.X1 < size.X1) then
   bx.X1 := size.X1;
 if (bx.Y1 < size.Y1) then
   bx.Y1 := size.Y1;
 if (bx.X2 > size.X2) then
   bx.X2 := size.X2;
 if (bx.Y2 > size.Y2) then
   bx.Y2 := size.Y2;
 Result := (bx <> tmp); 
end;

var
 original_bx, new_bx: TBox;

begin
 original_bx := Box(100, 100, 400, 400);
 WriteLn('original_bx: ' + BoxToStr(original_bx));
 new_bx := Box(200, 200, 600, 600);
 WriteLn('new_bx before: ' + BoxToStr(new_bx));
 SetBoxConstraints(new_bx, original_bx);
 WriteLn('new_bx after: ' + BoxToStr(new_bx)); 
 WriteLn('');
 new_bx := Box(50, 50, 500, 500);
 WriteLn('new_bx before: ' + BoxToStr(new_bx));
 SetBoxConstraints(new_bx, original_bx);
 WriteLn('new_bx after: ' + BoxToStr(new_bx)); 
 WriteLn('');
 new_bx := Box(250, 250, 999, 250);
 WriteLn('new_bx before: ' + BoxToStr(new_bx));
 SetBoxConstraints(new_bx, original_bx);
 WriteLn('new_bx after: ' + BoxToStr(new_bx));
end.

Edited by Janilabo
Link to comment
Share on other sites
LordJashin God Member

LordJashin

Posted
  • Author
Posted

Did I get it right?

 

[scar]

 

function TBAToParts(TBA: TBoxArray; method: (pm_PartSize, pm_PartAmount); x: Integer): T2DBoxArray;

var

a, e, h, h2, i, i2, p: Integer;

begin

h := High(TBA);

case method of

pm_PartSize:

if ((h >= 0) and (x > 0)) then

if (x <= h) then

begin

Inc(h);

p := (h div x);

if ((p * x) < h) then

Inc(p);

SetLength(Result, p);

for i := 0 to (p - 1) do

for i2 := 0 to (x - 1) do

begin

SetLength(Result, x);

if (a < h) then

begin

Result[i2] := TBA[a];

Inc(a);

end else

begin

SetLength(Result, i2);

Exit;

end;

end;

end else

Result := [TBA];

pm_PartAmount:

begin

if ((h <= 0) or (x < 2)) then

begin

if (x = 1) then

Result := [TBA]

else

if (x > 0) then

SetLength(Result, x);

Exit;

end;

if (h < (x - 1)) then

x := (h + 1);

p := Floor((h + 1) / x);

if (p = 0) then

p := 1;

e := ((h + 1) - (p * x));

if (e >= (h + 1)) then

e := 0;

SetLength(Result, x);

for i := 0 to (x - 1) do

begin

if ((e >= (i + 1)) and (e > 0)) then

SetLength(Result, (p + 1))

else

if (i <= h) then

SetLength(Result, p);

h2 := High(Result);

for i2 := 0 to h2 do

begin

Result[i2] := TBA[a];

Inc(a);

end;

end;

end;

end;

end;

[/scar]

 

Also meant to ask you about these functions too What do they do exactly?:

 

procedure MSSL_TBASkipBoxesByArea(var TBA: TBoxArray; skipArea: TBox; fromInside: Boolean);

procedure MSSL_TBASkipBoxesByAreas(var TBA: TBoxArray; skipAreas: TBoxArray; fromInside: Boolean);

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
Go to topic listing
×
×
  • Create New...