Point of contact in a moving point-circle collision using FreePacal/Lazarus - lazarus

I need to program a game in Lazarus/Freepascal. In this game, the player has the ability to "jump" from planet to planet, like This.
The jumping itself is implemented, but the landing doesn't work. At first I tried to calculate the right position for my player character using the law of cosine, but that didn't really work out. Then I tried to get the right position by rearranging the code I use for movement:
if getkeystate(vk_left) < 0 then
begin
currotp1 := currotp1 - 2;
end;
if getkeystate(vk_right) < 0 then
begin
currotp1 := currotp1 + 2;
end;
edit1.Text := IntToStr(currotp1);
GTR.left := trunc(-cos(currotp1 / 180 + pi) * (-r)) + curplaxp1;
GTR.top := trunc(-sin(currotp1 / 180 + pi) * (-r)) + curplayp1;
while currotp1 > 1130 do
begin
currotp1 := currotp1 - 1130;
end;
while currotp1 < 0 do
begin
currotp1 := currotp1 + 1130;
end;
Turned into:
addrotp1 := (-arccos(DegToRad((GTR.top - yorigins[notplanump1]) / (-
rs[notplanump1]))) - pi) * 180;
currotp1 := round(addrotp1);
For clarification:
Currotp1 is the current rotationvalue of player one. 1130 "units" is one full
rotation
GTR.left and GTR.top are the coordinates of my player
r is the radius of the "planet" the player is on
curplxp1 and curplayp1 are the coordinates of the center of the planet the
player is on.
addrotp1 is the additional rotation I want to apply on the player. It's
float.
yorigins[notplanump1] and xorigins[notplanump1] are the coordinates of the
planet the player is not on.
rs[notlpanump1] is the radius of the planet the player is not on.
Please suggest approaches/solutions to solve this problem.

Related

Formula to evenly arrange lines on perspective imitation?

In short: How to calculate h0...h4?
When imitating perspective, which formula is used to calculate h(0) to h(n) distances when known deformation values like either top-width-to-bottom-width ratio, or angle a (whichever parameter is useful for that)?
We can see perpective transformation having axial symmetry around vertical axis.
So transformation of rectangle with coordinates (0,0)-(SrcWdt, SrcHgt) with axial line at SrcWdt/2
gives trapezoid centered vertically with axial line at DstWdt/2 and coordinates of right corners RBX, RBY, RTX, RTY
In this case transformation formulas are a bit simpler (than general case)
X' = DstXCenter + A * (X - XCenter) / (H * Y + 1)
Y' = (RBY + E * Y) / (H * Y + 1)
And we can calculate coefficients A, E, H without solving of eight linear equation system using only coordinates of two corners of trapezoid.
Delphi code:
procedure CalcAxialSymPersp(SrcWdt, SrcHgt, DstWdt, RBX, RBY, RTX, RTY: Integer;
var A, H, E: Double);
begin
A := (2 * RBX - DstWdt) / SrcWdt;
H := (A * SrcWdt/ (2 * RTX - DstWdt) - 1) / SrcHgt;
E := (RTY * (H * SrcHgt + 1) - RBY) / SrcHgt;
end;
Having coefficients, we can apply transformation to any source point PSrc and get coordinates of mapped point. In your case PSrc.X = 0 and PSrc.Y = i * SrcHgt / 5 for i=1..4 will give Y-coordinates od horizontal lines.
procedure PerspMap(SrcWdt, DstWdt, RBY: Integer; A, H, E: Double; PSrc: TPoint): TPoint;
begin
Result.X := Round(DstWdt / 2 + A * (PSrc.X - SrcWdt/2) / (H * PSrc.Y + 1));
Result.Y := Round((RBY + E * PSrc.Y) / (H * PSrc.Y + 1));
end;

Time-efficient algorithm to find the largest area in a grid with constraints

In a 2D grid, we start from the origin (0, 0) and then we can move by one cell at the time with either (x+1, x-1, y+1, y-1).
I have to find the largest area with this constraint: for any point in the area, the sum of the digits of abs(x) plus the sum of the digits of abs(y) should be at most 23.
For example, the point (59,75) isn't valid because 5 + 9 + 7 + 5 = 26.
The point (-51, -7) is valid because 5 + 1 + 7 = 13, which is less than 23.
What could be a way to solve this with great time-complexity ?
Look at this picture. It shows as white those points with digits sum < 23 in the first quadrant reachable from coordinate origin (edit: needed <=23).
Seems it is not hard to make breadth-first search like flood-fill with special border condition sumdigit <=23 (coordinate limit is 699) and count them all.
White filling spreads from origin until border value is met. This process resembles water flooding with level 23. Black islands stay in white sea and solid black border limits it. Count of white pixels is area of continuous region around origin.
.
Moreover, it is possible to determine count of white points in every 100x100 square depending on its coordinates and get mathematical formula.
Scaled fragment:
Primitive implementation in Delphi (there are effective non-recursive Floodfill implementations) gives white pixel count 592597
var
mark: TDictionary<Integer, Integer>;
function digitsum(x, y: integer): integer;
begin
if mark.ContainsKey((x + 1000) * 2000 + y + 1000) then
Exit(9999);
Result := 0;
x := abs(x);
y := abs(y);
while y > 0 do begin
Result := Result + y mod 10;
y := y div 10;
end;
while x > 0 do begin
Result := Result + x mod 10;
x := x div 10;
end;
end;
function flood(x, y: integer): integer;
begin
if digitsum(x,y) > 23 then
Exit(0);
Result := 1;
mark.Add((x + 1000) * 2000 + y + 1000, 0);
Canvas.Pixels[x, y] := clWhite;
Inc(Result, flood(x + 1, y));
Inc(Result, flood(x - 1, y));
Inc(Result, flood(x, y - 1));
Inc(Result, flood(x, y + 1));
end;
begin
Canvas.Brush.Color := clBlack;
Canvas.FillRect(ClientRect);
mark:= TDictionary<Integer, Integer>.Create;
Caption := flood(0, 0).ToString;

Coordinates of every point on a circle's circumference

First, please note, that this question is not a duplicate of these: 1st , 2nd , and 3rd.
I am using delphi and openCV, but I am looking for an algorithm, a solution regardless of the language.
For the purpose of a precise image analysis, I need to check for changes in pixel intensity in circular areas. So I read pixel values on a circumference of continuously growing circle. To be able to do that, I of course need to know coordinates of the pixels.
The best solution I found is y:= Round(centerY + radius * sin(angle)), x:= Round(centerX + radius * cos(angle)), while because counting with only 360 degrees is hardly enough, when the radius of the circle is larger, than circa 60px, the angle is being counted like this angle:= angle + (360 / (2 * 3.14 * currentRadius)) -> I sweep through every value from 0 to 360, while the value is being incremented by a fraction of 360/circumference of the circle in pixels. But this approach is not very precise. The larger the circle, the smaller the fraction of the angle needs to be and the precission suffers from the inaccuracy of Pi, plus the rounding.
If I use the mentioned method, and try to draw the counted pixels with this code:
centerX:= 1700;
centerY:= 1200;
maxRadius:= 500;
for currentRadius:= 80 to maxRadius do
begin
angle:= 0;
while angle < 360 do
begin
xI:= Round(centerX + currentRadius * cos(angle));
yI:= Round(centerY + currentRadius * sin(angle));
angle:= angle + (360 / (2 * 3.14 * currentRadius));
//this is openCV function, to test the code, you can use anything, that will draw a dot...
cvLine(image,cvPoint(xI,yI),cvPoint(xI,yI),CV_RGB(0, 255, 0));
end;
end;
the result is this:
It is not bad, but taking into account, that rougly a third of all pixels in the circular area are black, you realize, that a lot of pixels has been "skipped". Plus looking closely on the edge of the last circle, there is clearly visible, that some dots are off the actual circumference - another result of the inaccuracy...
I could possibly use a formula (x - xorig)^2 + (y - yorig)^2 = r^2 to check every possible pixel in a rectangular area around the center, slightly bigger, than a diameter of the circle, if it does, or does't fall onto the cirle's circumference. But that would be very slow to repeat it all the time, as the circle grows.
Is there something, that could be done better? Could anyone help me to improve this? I don't insist on anything from my solution at all, and will accept any other solution, as long as it gives the desired results => let me read values of all (or the vast majority - 95%+) pixels on a circumference of a circle with given center and radius. The faster, the better...
1) Build a list of pixels of the smallest radius circumference. It is enough to
keep the first octant (range 0..Pi/4 in the 1st quadrant of coordinate system) of circle, and get symmetric points with reflections.
You can use, for example, Bresenham circle algorithm or just circle equation.
2) For the next iteration walk through all coordinates in the list (use right one, if there are two points with the same Y value) and check whether right neighbor (or two neighbors!) lies inside the next radius. For the last point check also top, right-top neighbor (at Pi/4 diagonal).
Insert good neighbors (one or two) into the next coordinate list.
Example for Y=5.
R=8 X=5,6 //note that (5,5) point is not inside r=7 circle
R=9 X=7
R=10 X=8
R=11 X=9
R=12 X=10
R=13 X=11,12 //!
R=14 X=13
With this approach you will use all the pixels in maximal radius circle without gaps, and checking process for list generation is rather fast.
Edit:
Code implements slightly another approach, it uses lower line pixel limit to built upper line.
It generates circles in given range, paints them to psychedelic colors. All math is in integers, no floats, no trigonometric functions! Pixels are used only for demonstration purposes.
procedure TForm1.Button16Click(Sender: TObject);
procedure FillCircles(CX, CY, RMin, RMax: Integer);
//control painting, slow due to Pixels using
procedure PaintPixels(XX, YY, rad: Integer);
var
Color: TColor;
r, g, B: Byte;
begin
g := (rad mod 16) * 16;
r := (rad mod 7) * 42;
B := (rad mod 11) * 25;
Color := RGB(r, g, B);
// Memo1.Lines.Add(Format('%d %d %d', [rad, XX, YY]));
Canvas.Pixels[CX + XX, CY + YY] := Color;
Canvas.Pixels[CX - YY, CY + XX] := Color;
Canvas.Pixels[CX - XX, CY - YY] := Color;
Canvas.Pixels[CX + YY, CY - XX] := Color;
if XX <> YY then begin
Canvas.Pixels[CX + YY, CY + XX] := Color;
Canvas.Pixels[CX - XX, CY + YY] := Color;
Canvas.Pixels[CX - YY, CY - XX] := Color;
Canvas.Pixels[CX + XX, CY - YY] := Color;
end;
end;
var
Pts: array of array [0 .. 1] of Integer;
iR, iY, SqD, SqrLast, SqrCurr, MX, LX, cnt: Integer;
begin
SetLength(Pts, RMax);
for iR := RMin to RMax do begin
SqrLast := Sqr(iR - 1) + 1;
SqrCurr := Sqr(iR);
LX := iR; // the most left X to check
for iY := 0 to RMax do begin
cnt := 0;
Pts[iY, 1] := 0; // no second point at this Y-line
for MX := LX to LX + 1 do begin
SqD := MX * MX + iY * iY;
if InRange(SqD, SqrLast, SqrCurr) then begin
Pts[iY, cnt] := MX;
Inc(cnt);
end;
end;
PaintPixels(Pts[iY, 0], iY, iR);
if cnt = 2 then
PaintPixels(Pts[iY, 1], iY, iR);
LX := Pts[iY, 0] - 1; // update left limit
if LX < iY then // angle Pi/4 is reached
Break;
end;
end;
// here Pts contains all point coordinates for current iR radius
//if list is not needed, remove Pts, just use PaintPixels-like output
end;
begin
FillCircles(100, 100, 10, 100);
//enlarge your first quadrant to check for missed points
StretchBlt(Canvas.Handle, 0, 200, 800, 800, Canvas.Handle, 100, 100, 100,
100, SRCCOPY);
end;
If you want to make your code faster, don't call trigonometric functions inside the inner loop, increment sin(angle) and cos(angle) using
sin(n*step)=sin((n-1)*step)*cos(step)+sin(step)*cos((n-1)*step)
cos(n*step)=cos((n-1)*step)*cos(step)-sin(step)*sin((n-1)*step)
that is
...
for currentRadius:= 80 to maxRadius do
begin
sinangle:= 0;
cosangle:= 1;
step:= 1 / currentRadius; // ?
sinstep:= sin(step);
cosstep:= cos(step);
while {? } do
begin
xI:= Round(centerX + currentRadius * cosangle);
yI:= Round(centerY + currentRadius * sinangle);
newsin:= sinangle*cosstep + sinstep*cosangle;
newcos:= cosangle*cosstep - sinstep*sinangle;
sinangle:= newsin;
cosangle:= newcos;
...
end;
end;
First of all: you want all the points on a circle circumference. If you use any (good) algorithm, also some built-in circle function, you get indeed all the points, since the circumference is connected.
What your picture shows, there are holes between neighbour circles, say r=100 and r=101. This is so for circumference drawing functions.
Now if you want that the pixels in your pixel set to cover all the pixels with incrementing radii, you can simply use following approach:
Build a set of filled circle pixels, say r = 101
Build a set of filled circle pixel with r = 100
Exclude set 2 from set 1
Filled circle algorithm is generally more efficient and simpler than connected circumference so you'll not loose much performance.
So you get a circumference which is slightly thicker than 1 px, but this set will surely cover the surface with growing radii without any holes. But it can also happen that the set built in such a way has overlapping pixels with previous set (r-1), so you'd know it better if you test it.
PS: Also it is not clear how any trigonometric functions appear in your code. I don't know any effective circle algorithm which use anything other than square root.
Why don't you simply use more digits for Pi and stop rounding to improve accuracy?
Further I suggest you use subpixel coordinates to get more accurate intensity values if you can afford the interpolation.
It's also very uncommon to use degrees in calculations. I highly recommend using radians. Not sure which functions you use here but Delphi's cos and sin seem to expect radians!

Make only one round corner antialiased to an image

everyone
I've been trying to solve the following problem in Delphi.
I want to make take an image and to make just one antialiased round corner.
I know how to make all 4 corners round by using RoundRect. However, I don't seem to figure out how to make just one.
I've been trying to solve the problem like this:
procedure RoundCorner(var image: TBitmap; w,h : integer);
//w - width of an image
//h - height of an image
//radius can be set at 150 (rounded rect radius)
// image is the timage object received as var parameter
var
i, j :integer;
x, y :double;
begin
i:= w - Trunc(radius);
x:= 0;
y:= radius - sqrt(sqr(radius) - sqr(x));
while(i < w) do
begin
j:=0;
while(j <= y) do
begin
image.Canvas.Pixels[i-1,j]:=clWhite; //a colour of your choosing or just erase this line
j := j + 1;
end;
y:= radius - sqrt(sqr(radius) - sqr(x));
x := x + 1;
i := i + 1;
end;
end;
This works, however I'm faced with 2 problems:
The corner is not antialiased
I want to fill the cut region with a different colour
Any suggestions are welcomed
Thanks.
First of all in your case "antialiasing" does mean that your image have to have a 32 bit pixel format in order to make a round transparent corner. Second thing is that you cannot access alpha channel via Canvas, you would need to access bitmap pixels directly via Scanline property or maybe to use a library like Graphics32 or AGG.
Another "modern" way to implement round corner is to use FMX and put the image inside a roundrect and clip it by the roundrect.

Modify per-pixel alpha data for TPngImage

Can I directly modify per-pixel alpha data for TPngImage between loading it from somewhere and drawing it somewhere? If so, how? Thanks.
Yes, I think that is easy.
For example, this code will set the opacity to zero (that is, the transparency to 100 %) on every pixel in the upper half of the image:
var
png: TPNGImage;
sl: PByteArray;
...
for y := 0 to png.Height div 2 do
begin
sl := png.AlphaScanline[y];
FillChar(sl^, png.Width, 0);
end;
This will make a linear gradient alpha channel, from full transparency (alpha = 0) to full opacity (alpha = 255) from left to right:
for y := 0 to png.Height do
begin
sl := png.AlphaScanline[y];
for x := 0 to png.Width - 1 do
sl^[x] := byte(round(255*x/png.Width));
end;
Basically, what I am trying to say, is that
(png.AlphaScanline[y]^)[x]
is the alpha value (the opacity), as a byte, of the pixel at row y and col x.
You could use something like this:
for Y := 0 to Image.Height - 1 do begin
Line := Image.AlphaScanline[Y];
for X := 0 to Image.Width - 1 do begin
Line[X] := ALPHA
end;
end;

Resources