Error setting the video mode when trying to run the compiled Game_Support example; GNAT Studio; - sdl

Trying to compile example /opt/gnatstudio/share/examples/training/games/bouncing/bouncing.gpr
There are no problems when compiling, but when running -
Error setting the video mode
UNCAUGHT EXCEPTION ===
raised STORAGE_ERROR : s-intman.adb:136 explicit raise
Code sample, which I used (it had been moved to another folder, because it does not want to compile in /opt/ - no rights).
with Display; use Display;
with Display.Basic; use Display.Basic;
with Ada.Numerics; use Ada.Numerics;
with Ada.Numerics.Generic_Elementary_Functions;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Numerics.Float_Random; use Ada.Numerics.Float_Random;
procedure Bouncing is
Seed : Generator;
Buffer_Size : constant := 1_200;
package F_Numeri is new Ada.Numerics.Generic_Elementary_Functions (Float);
use F_Numeri;
Base_Immunity : constant := 500;
type Ball is record
X, Y : Float := 0.0;
Dx, Dy : Float := 0.0;
Size : Float := 0.0;
Mass : Float := 1.0;
S : Shape_Id := Null_Shape_Id;
Immunity : Integer := Base_Immunity;
end record
with Dynamic_Predicate => Ball.Mass > 0.0;
type Shape_Array_Type is array (Integer range <>) of Shape_Id;
type Ball_Array_Type is array (Integer range <>) of Ball;
Null_Ball : constant Ball := Ball'(X => 0.0,
Y => 0.0,
Dx => 0.0,
Dy => 0.0,
Size => 0.0,
Mass => 1.0,
S => Null_Shape_Id,
Immunity => Base_Immunity);
Total_Ball : Integer := 0;
function Speed (B : Ball) return Float is
(Sqrt (B.Dx * B.Dx + B.Dy * B.Dy));
function Cynetic_Energy (B : Ball) return Float is
(1.0 / 2.0 * B.Mass * Speed (B) * Speed (B));
function Speed (Cy : Float; Mass : Float) return Float is
(Sqrt (Cy * 2.0 / Mass));
procedure Create_Ball
(X : Float; Y : Float; Mass : Float; Velocity : Float; Balls : in out Ball_Array_Type; J : Integer);
type Int_Array is array (Integer range <>) of Integer range 0 .. Buffer_Size;
type Bool_Array is array (Integer range <>) of Boolean;
protected Collision_Manager is
procedure Reset;
procedure Set_Collision (J, K : Integer);
procedure Keep_Immunity (J : Integer);
function Collision_With (J : Integer) return Integer;
function Should_Keep_Immunity (J : Integer) return Boolean;
private
Collision_Vector : Int_Array (1 .. Buffer_Size);
Immunity_Vector : Bool_Array (1 .. Buffer_Size);
end Collision_Manager;
protected body Collision_Manager is
procedure Reset is
begin
Collision_Vector := (others => 0);
Immunity_Vector := (others => False);
end Reset;
procedure Set_Collision (J, K : Integer) is
begin
Collision_Vector (J) := K;
end Set_Collision;
procedure Keep_Immunity (J : Integer) is
begin
Immunity_Vector (J) := True;
end Keep_Immunity;
function Collision_With (J : Integer) return Integer is
begin
return Collision_Vector (J);
end Collision_With;
function Should_Keep_Immunity (J : Integer) return Boolean is
begin
return Immunity_Vector (J);
end Should_Keep_Immunity;
end Collision_Manager;
procedure Create_Graphic (B : in out Ball) is
begin
B.S := New_Circle
(B.X, B.Y, B.Size,
(if B.Size > 15.0 then Blue
elsif B.Size > 10.0 then Green
elsif B.Size > 5.0 then Yellow
elsif B.Size > 2.0 then Magenta
else Red));
end Create_Graphic;
function Collision (B1, B2 : Ball) return Boolean is
Dx, Dy : Float;
Size : Float;
begin
if B1 = Null_Ball or else B2 = Null_Ball then
return False;
end if;
Dx := B1.X - B2.X;
Dy := B1.Y - B2.Y;
Size := B1.Size + B2.Size;
return Dx * Dx + Dy * Dy <= Size * Size;
end Collision;
procedure Bounce (B1, B2 : in out Ball) is
Dx : Float;
Dy : Float;
Length : Float;
Dvx : Float;
Dvy : Float;
Impulse : Float;
begin
Dx := B1.X - B2.X;
Dy := B1.Y - B2.Y;
Length := Sqrt (Dx * Dx + Dy * Dy);
if Length /= 0.0 then
Dx := Dx / Length;
Dy := Dy / Length;
Dvx := B1.Dx - B2.Dx;
Dvy := B1.Dy - B2.Dy;
Impulse := -2.0 * (Dx * Dvx + Dy * Dvy);
Impulse := Impulse / (1.0 / B1.Mass + 1.0 / B2.Mass);
B1.Dx := B1.Dx + Dx * (Impulse / B1.Mass);
B1.Dy := B1.Dy + Dy * (Impulse / B1.Mass);
B2.Dx := B2.Dx - Dx * (Impulse / B2.Mass);
B2.Dy := B2.Dy - Dy * (Impulse / B2.Mass);
end if;
end Bounce;
procedure Explode (Balls : in out Ball_Array_Type; Index : Integer) is
B : Ball := Balls (Index);
V : Float;
Cy : Float;
Sub_Particles : Integer;
begin
Sub_Particles := Integer (Log (X => B.Mass, Base => 2.0) + 1.0);
Total_Ball := Total_Ball - 1;
V := Sqrt (B.Dx * B.Dx + B.Dy * B.Dy);
Cy := 1.0 / 2.0 * B.Mass * V * V;
Delete (Balls (Index).S);
Balls (Index) := Null_Ball;
for J in 1 .. Sub_Particles loop
for K in Balls'Range loop
if Balls (K) = Null_Ball then
Create_Ball
(X => B.X + Random (Seed) * B.Size - B.Size / 2.0,
Y => B.Y + Random (Seed) * B.Size - B.Size / 2.0,
Mass => B.Mass / Float (Sub_Particles),
Velocity => Speed
(Cy / Float (Sub_Particles),
B.Mass / Float (Sub_Particles)),
Balls => Balls,
J => K);
Create_Graphic (Balls (K));
exit;
end if;
end loop;
end loop;
end Explode;
procedure Combine (Balls : in out Ball_Array_Type; J, K : Integer) is
B1 : Ball := Balls (J);
B2 : Ball := Balls (K);
Cy : Float := Cynetic_Energy (B1) + Cynetic_Energy (B2);
begin
Total_Ball := Total_Ball - 2;
Delete (Balls (K).S);
Balls (K) := Null_Ball;
Delete (Balls (J).S);
Create_Ball
(B1.X + (B1.X - B2.X) / 2.0,
B1.Y + (B1.Y - B2.Y) / 2.0,
B1.Mass + B2.Mass,
Speed (Cy, B1.Mass + B2.Mass),
Balls,
J);
Create_Graphic (Balls (J));
end Combine;
procedure Create_Ball
(X : Float; Y : Float; Mass : Float;
Velocity : Float; Balls : in out Ball_Array_Type; J : Integer)
is
B : Ball renames Balls (J);
Angle : Float := Random (Seed) * 2.0 * Pi;
begin
Total_Ball := Total_Ball + 1;
B.X := X;
B.Y := Y;
B.Dx := Cos (Angle) * Velocity;
B.Dy := Sin (Angle) * Velocity;
B.Mass := Mass;
B.Size := Sqrt (B.Mass);
B.Immunity := Base_Immunity;
Collision_Manager.Keep_Immunity (J);
end Create_Ball;
Lines : constant Shape_Array_Type (1 .. 4) :=
(New_Line (-100.0, -100.0, 100.0, -100.0, Blue),
New_Line (-100.0, -100.0, -100.0, 100.0, Blue),
New_Line (100.0, 100.0, 100.0, -100.0, Blue),
New_Line (100.0, 100.0, -100.0, 100.0, Blue));
R : Float;
Balls_Txt : Shape_Id := New_Text (110.0, 90.0, "0", White);
Explode_Txt : Shape_Id := New_Text (110.0, 80.0, "0", White);
Combine_Txt : Shape_Id := New_Text (110.0, 70.0, "0", White);
Combine_Prob : Float := 0.04;
Explode_Prob : Float := 0.02;
Ball_Array : Ball_Array_Type (1 .. Buffer_Size) := (others => Null_Ball);
task type Collision_Detection (Size, Modulus, Ind : Integer) is
entry Compute;
entry Finished;
entry Stop;
end Collision_Detection;
task body Collision_Detection is
Do_Work : Boolean := True;
J : Integer;
begin
while Do_Work loop
select
accept Compute;
J := Ind;
if J = 0 then
J := J + Modulus;
end if;
while J <= Size loop
if Ball_Array (J) /= Null_Ball then
for K in J + 1 .. Ball_Array'Last loop
if Collision (Ball_Array (J), Ball_Array (K)) then
if Ball_Array (J).Immunity = 0
and then Ball_Array (K).Immunity = 0
then
Collision_Manager.Set_Collision (J, K);
end if;
Collision_Manager.Keep_Immunity (J);
Collision_Manager.Keep_Immunity (K);
end if;
end loop;
end if;
J := J + Modulus;
end loop;
accept Finished;
or
accept Stop;
Do_Work := False;
end select;
end loop;
end Collision_Detection;
D1 : Collision_Detection (1200, 4, 0);
D2 : Collision_Detection (1200, 4, 1);
D3 : Collision_Detection (1200, 4, 2);
D4 : Collision_Detection (1200, 4, 3);
begin
for J in 1 .. 20 loop
declare
B : Ball renames Ball_Array (J);
begin
Create_Ball (0.0, 0.0, Random (Seed) * 75.0 + 4.0, 0.5, Ball_Array, J);
Create_Graphic (B);
end;
end loop;
loop
Collision_Manager.Reset;
D1.Compute;
D2.Compute;
D3.Compute;
D4.Compute;
D1.Finished;
D2.Finished;
D3.Finished;
D4.Finished;
for J in Ball_Array'Range loop
if Ball_Array (J) /= Null_Ball then
declare
K : Integer;
begin
if not Collision_Manager.Should_Keep_Immunity (J) then
Ball_Array (J).Immunity := 0;
end if;
K := Collision_Manager.Collision_With (J);
if K /= 0 and then Ball_Array (K) /= Null_Ball then
R := Random (Seed);
if R in 1.0 - Explode_Prob - Combine_Prob
1.0 - Combine_Prob
then
if Ball_Array (J).Mass > Ball_Array (K).Mass then
Explode (Ball_Array, J);
else
Explode (Ball_Array, K);
end if;
elsif R in 1.0 - Combine_Prob .. 1.0 then
Combine (Ball_Array, J, K);
else
Bounce (Ball_Array (J), Ball_Array (K));
end if;
end if;
end;
end if;
end loop;
for J in Ball_Array'Range loop
declare
B : Ball renames Ball_Array (J);
begin
if B /= Null_Ball then
if (B.X - B.Size < -100.0 and then B.Dx < 0.0)
or else (B.X + B.Size > 100.0 and then B.Dx > 0.0)
then
B.Dx := -B.Dx;
end if;
if (B.Y - B.Size< -100.0 and then B.Dy < 0.0)
or else (B.Y + B.Size> 100.0 and then B.Dy > 0.0)
then
B.Dy := -B.Dy;
end if;
B.X := B.X + B.Dx;
B.Y := B.Y + B.Dy;
if B.Immunity > 0 then
B.Immunity := B.Immunity - 1;
end if;
Set_X (B.S, B.X);
Set_Y (B.S, B.Y);
end if;
end;
end loop;
Set_Text (Balls_Txt, "Balls:" & Total_Ball'Img);
Set_Text (Explode_Txt, "Explode Prob:" & Integer (Explode_Prob * 1000.0)'Img & " / 1000");
Set_Text (Combine_Txt, "Combine Prob:" & Integer (Combine_Prob * 1000.0)'Img & " / 1000");
declare
Last_Key : Key_Type := Current_Key_Press;
begin
if To_Character (Last_Key) = 'q' then
Explode_Prob := Explode_Prob - 0.001;
elsif To_Character (Last_Key) = 'w' then
Explode_Prob := Explode_Prob + 0.001;
elsif To_Character (Last_Key) = 'a' then
Combine_Prob := Combine_Prob - 0.001;
elsif To_Character (Last_Key) = 's' then
Combine_Prob := Combine_Prob + 0.001;
end if;
end;
delay 0.01;
end loop;
end Bouncing;
The project file itself
bouncing.gpr
with "/opt/gnatstudio/share/gpr/game_support.gpr";
with "/opt/gnatstudio/share/gpr/gnat_sdl.gpr";
project bouncing is
for Main use("bouncing.adb");
for Object_Dir use "obj";
for Source_Dirs use("src");
end Bouncing;
tually, I had been compile and run some more simple example with the same result:
with Display; use Display;
with Display.Basic; use Display.Basic;
procedure Main is
Ball : Shape_Id := New_Circle
(X => 0.0,
Y => 0.0,
Radius => 10.0,
Color => Blue);
Step : Float := 0.05;
begin
loop
if Get_X (Ball) > 100.0 then
Step := -0.05;
elsif Get_X (Ball) < -100.0 then
Step := 0.05;
end if;
Set_X (Ball, Get_X (Ball) + Step);
delay 0.001;
end loop;
end Main;
I had tried to recompile Game_Support, git cloned from here.
I had tried to reinstall GNAT, Gnat Studio, etc.
I CAN run and compile another simple projects, for example with TEXT_IO package, I can run Gnat Studio, but I cannot run this app. I can run analogue, wrote with C++, so the problem is not in my OpenGl 1.3 hardware support.
System: Arch Linux.
IDE: Gnat Studio. (Install from AUR).
Dependencies (SDL, SDL2) - installed.

Related

Cubic Interpolation with the official formula fails

I am trying to implement the Cubic Interpolation method using the next formula when a=-0.5 as usual.
My Linear Interpolation and Nearest Neighbor interpolation is working great but for some reason the Cubic interpolation fails with white pixels and turn them sometimes to turquoise color and sometimes messing around with another colors.
for example using rotation: (NOTE: please look carefully on the right image and you will notice the problems)
Another Example with much more black pixels. It almost seems to work perfectly but look on the dog's tongue. (strong white pixels turn to turquoise again)
you can see that my implementation of the Linear Interpolation is working great:
Since the actual rotation worked, I think I have a small mistake in the code that I did not notice, or maybe it's a numeric error or a double / float error.
It is important to note that I read the image normally and store the destination image as follows:
cv::Mat img = cv::imread("../dogfails.jpeg");
cv::Mat rotatedImageCubic(img.rows,img.cols,CV_8UC3);
Clarifications:
Inside my cubic interpolation function, srcPoint (newX and newY) is the "landing point" from the inverse transformation.
In my inverse transformations I am not using matrix multiplication with the pixels, right now I am just using the formulas for rotation. It might be important for the "numerical errors". For example:
rotatedX = x * cos(angle * toRadian) + y * sin(angle * toRadian);
rotatedY = x * (-sin(angle * toRadian)) + y * cos(angle * toRadian);
Here is my code for the Cubic Interpolation
double cubicEquationSolver(double d,double a) {
d = abs(d);
if( 0.0 <= d && d <= 1.0) {
double score = (a + 2.0) * pow(d, 3.0) - ((a + 3.0) * pow(d, 2.0)) + 1.0;
return score;
}
else if(1 < d && d <= 2) {
double score = a * pow(d, 3.0) - 5.0*a * pow(d, 2.0) + 8.0*a * d - 4.0*a;
return score;
}
else
return 0.0;
}
void Cubic_Interpolation_Helper(const cv::Mat& src, cv::Mat& dst, const cv::Point2d& srcPoint, cv::Point2i& dstPixel) {
double newX = srcPoint.x;
double newY = srcPoint.y;
double dx = abs(newX - round(newX));
double dy = abs(newY - round(newY));
double sumCubicBValue = 0;
double sumCubicGValue = 0;
double sumCubicRValue = 0;
double sumCubicGrayValue = 0;
double uX = 0;
double uY = 0;
if (floor(newX) - 1 < 0 || floor(newX) + 2 > src.cols - 1 || floor(newY) < 0 || floor(newY) > src.rows - 1) {
if (dst.channels() > 1)
dst.at<cv::Vec3b>(dstPixel) = cv::Vec3b(0, 0,0);
else
dst.at<uchar>(dstPixel) = 0;
}
else {
for (int cNeighbor = -1; cNeighbor <= 2; cNeighbor++) {
for (int rNeighbor = -1; rNeighbor <= 2; rNeighbor++) {
uX = cubicEquationSolver(rNeighbor + dx, -0.5);
uY = cubicEquationSolver(cNeighbor + dy, -0.5);
if (src.channels() > 1) {
sumCubicBValue = sumCubicBValue + (double) src.at<cv::Vec3b>(
cv::Point2i(round(newX) + rNeighbor, cNeighbor + round(newY)))[0] * uX * uY;
sumCubicGValue = sumCubicGValue + (double) src.at<cv::Vec3b>(
cv::Point2i(round(newX) + rNeighbor, cNeighbor + round(newY)))[1] * uX * uY;
sumCubicRValue = sumCubicRValue + (double) src.at<cv::Vec3b>(
cv::Point2i(round(newX) + rNeighbor, cNeighbor + round(newY)))[2] * uX * uY;
} else {
sumCubicGrayValue = sumCubicGrayValue + (double) src.at<uchar>(
cv::Point2i(round(newX) + rNeighbor, cNeighbor + round(newY))) * uX * uY;
}
}
}
if (dst.channels() > 1)
dst.at<cv::Vec3b>(dstPixel) = cv::Vec3b((int) round(sumCubicBValue), (int) round(sumCubicGValue),
(int) round(sumCubicRValue));
else
dst.at<uchar>(dstPixel) = sumCubicGrayValue;
}
I hope someone here will be able to help me, Thanks!

Unhandled exception at 0x001D6653 in Lid.exe: 0xc0000094: integer division by zero

I am trying to write the code for Lid-Driven Cavity in Fortran.
When I want to run the code, suddenly the integer division by zero errors appears.
I know what is the problem but I don't know how I can solve it. I even changed some numbers in order to avoid this issue but again happened.
I uploaded the photo of the error
I searched about it and there are some answers for C++ but I could not find anything for Fortran.
Program Lid
implicit none
Integer :: I,J,nx, ny, dx, dy, L, W, Iteration, Max_Iteration , Re, M, N, dt
Real :: Delta
Real, allocatable :: u(:,:), v(:,:), p(:,:), u_old(:,:), v_old(:,:), p_old(:,:), X(:), Y(:)
!***************************************************!
PRINT *, "ENTER THE DESIRED POINTS ..."
PRINT *, "... IN X DIRECTION: SUGGESTED RANGE (20-200)"
READ*, M
PRINT *, "... IN Y DIRECTION: SUGGESTED RANGE (10-100)"
READ*, N
! Define Geometry
dt = 0.001
Delta = 2
Re = 100
L = 10
W = 10
dx = L /Real(M-1)
dy = W /Real(N-1)
ALLOCATE (X(M),Y(N),u(M,N),u_old(M,N),v(M,N),v_old(M,N),p(M,N),p_old(M,N))
! Grid Generation
Do I = 1, M
x(I) = (I-1)* dx
End Do
Do J=1 , N
y(J) = (J-1) * dy
End Do
! Boundray Condition
Do I=1 , M
u(I,1) = 0
u(1,I) = 0
u(M,I) = 0
u(I,M) = 1 ! Lid Velocity
End Do
Do J=1, N
v(J,1) = 0
v(1,J) = 0
v(J,N) = 0
v(M,J) = 0
End Do
! Initialization
Do I=2, M-1
Do J=2, N-1
u(I,J) = 0
v(I,J) = 0
p(I,J) = 0
End Do
End Do
! Solver
Do I=2, M-1
Do J=2, N-1
u_old(I,J) = u(I,J)
v_old(I,J) = v(I,J)
p_old(I,J) = p(I,J)
u(I,J) = - dt / 4* dx * (( u(I, J+1)+ u_old(I,J))**2 - (u_old(I, J)+u(I,J-1))**2) - dt / 4* dy * ((u_old(I,J)+ u(I-1,J)) &
* (v(I-1,J) + v(I-1, J+1)) - (u_old(I,J) + u(I+1,J)) * (v_old(I,J) + v(I,J+1))) - dt / dx *(p(I, J+1) - p(I,J)) &
+ dt / Re * ((u(I+1,J) - 2 * u_old(I,J) + u(I-1,J)) / dx**2 + (u(I,J+1) - 2 * u_old(I,J) + u(I,J+1)) / dy**2) + u_old(I,J)
v(I,J) = - dt / 4* dy * (( v(I-1, J)+ v(I-1,J+1))**2 - (v_old(I, J)+v(I,J+1))**2) - dt / 4* dx * ((u_old(I,J)+ u(I,J+1)) &
* (v(I,J+1) + v(I-1, J+1)) - (u_old(I,J) + u(I,J-1)) * (v_old(I,J) + v(I-1,J))) - dt / dy *(p(I, J+1) - p(I,J)) &
+ dt / Re * ((v(I+1,J) - 2 * v_old(I,J) + v(I-1,J)) / dx**2 + (v(I,J+1) - 2 * v_old(I,J) + v(I,J+1)) / dy**2) + v_old(I,J)
p(I,J) = - Delta * dt / 2 * ((u(I,J+1)+ u_old(I,J)) - (u_old(I,J) + u(I,J-1))) - Delta * dt / 2 &
* ((v(I-1,J)+ v(I-1,J+1)) - (v_old(I,J) + v(I,J+1)))
End Do
End Do
!-----------------------OUTPUTS GENERATION-----------------------------
OPEN (1,FILE='FIELD.PLT')
WRITE (1,*) 'VARIABLES=X,Y,u,v,p'
WRITE (1,*) 'ZONE I=',M,' J=',N
DO J=1,N
DO I=1,M
WRITE (1,*) X(I),Y(J),u(I,J),v(I,J),p(I,J)
END DO
END DO
End Program Lid
Assuming that the yellow arrow shown on the image indicates the line (72) where the exception occurred:
Apparently dx is or becomes zero, because that's the only devision done on that line.
You must know what it means when dx is zero or what causes it, unless it's a programming or data input issue that causes it.
In any case you must make sure that you don't execute that part of your code that divides by zero.
What you need to do to prevent this, fully depends on what your code is supposed to do. I can't help you with that.

What's causing these artefacts in my 2D Perlin noise?

I implemented the improved Perlin noise algorithm. The code as provided for 3D noise works correctly.
I adjusted the algorithm to make a 2D version in what seemed the obvious way. It almost works, but produces artefacts as the images below show.
Here is the correct 3D version:
unsigned inc (unsigned number)
{
return (number + 1) & 255;
}
double fade (double t)
{
// Fade function as defined by Ken Perlin.
// This eases coordinate values
// so that they will "ease" towards integral values.
// This ends up smoothing the final output.
// 6t^5 - 15t^4 + 10t^3
return t * t * t * (t * (t * 6 - 15) + 10);
}
double lerp (double a, double b, double x)
{
return a + x * (b - a);
}
double grad (unsigned hash, double x, double y, double z)
{
// Take the hashed value and take the first 4 bits of it
// (15 == 0b1111)
unsigned h = hash & 15;
// If the most significant bit (MSB) of the hash is 0
// then set u = x. Otherwise y.
double u = h < 8 /* 0b1000 */ ? x : y;
double v;
if (h < 4 /* 0b0100 */)
// If the first and second significant bits
// are 0, set v = y
v = y;
else if (h == 12 /* 0b1100 */ || h == 14 /* 0b1110*/)
// If the first and second significant bits
// are 1, set v = x
v = x;
else
// If the first and second significant bits are not
// equal (0/1, 1/0) set v = z
v = z;
// Use the last 2 bits to decide if u and v are positive
// or negative. Then return their addition.
return ((h&1) == 0 ? u : -u) + ((h&2) == 0 ? v : -v);
}
double
ImprovedNoise :: noise (double x, double y, double z)
{
// Calculate the "unit cube" that the point asked will be located in
// The left bound is ( |_x_|,|_y_|,|_z_| ) and the right bound is that
// plus 1. Next we calculate the location (from 0.0 to 1.0) in that
// cube. We also fade the location to smooth the result.
int xi = (int)x & 255;
int yi = (int)y & 255;
int zi = (int)z & 255;
double xf = x - (int) x;
double yf = y - (int) y;
double zf = z - (int) z;
double u = fade (xf);
double v = fade (yf);
double w = fade (zf);
int aaa, aba, aab, abb, baa, bba, bab, bbb;
auto & p = permutation;
aaa = p[p[p[ xi ] + yi ] + zi ];
aba = p[p[p[ xi ] + inc(yi)] + zi ];
aab = p[p[p[ xi ] + yi ] + inc(zi)];
abb = p[p[p[ xi ] + inc(yi)] + inc(zi)];
baa = p[p[p[inc(xi)] + yi ] + zi ];
bba = p[p[p[inc(xi)] + inc(yi)] + zi ];
bab = p[p[p[inc(xi)] + yi ] + inc(zi)];
bbb = p[p[p[inc(xi)] + inc(yi)] + inc(zi)];
double x1, x2, y1, y2;
// The gradient function calculates the dot product between a
// pseudorandom gradient vector and the vector from the input
// coordinate to the 8 surrounding points in its unit cube.
// This is all then lerped together as a sort of weighted average
// based on the faded (u,v,w) values we made earlier.
x1 = lerp (
grad (aaa, xf , yf , zf),
grad (baa, xf-1, yf , zf),
u);
x2 = lerp (
grad (aba, xf , yf-1, zf),
grad (bba, xf-1, yf-1, zf),
u);
y1 = lerp (x1, x2, v);
x1 = lerp (
grad (aab, xf , yf , zf-1),
grad (bab, xf-1, yf , zf-1),
u);
x2 = lerp (
grad (abb, xf , yf-1, zf-1),
grad (bbb, xf-1, yf-1, zf-1),
u);
y2 = lerp (x1, x2, v);
auto result = (lerp (y1, y2, w) + 1) / 2;
assert (0 <= result);
assert (result <= 1);
assert (false == std :: isnan (result));
return result;
}
I generate a 2D image by fixing z=0. This a frequency of 10 so x,y are in [0..10]:
My 2D version:
double grad (unsigned hash, double x, double y)
{
double u = (hash & 1) ? x : y;
double v = (hash & 2) ? x : y;
return ((hash & 4) ? u : -u) + (hash & 8) ? v : -v;
}
double
ImprovedNoise :: noise (double x, double y)
{
int xi = (int)x & 255;
int yi = (int)y & 255;
double xf = x - (int) x;
double yf = y - (int) y;
double u = fade (xf);
double v = fade (yf);
int aaa, aba,baa, bba;
auto & p = permutation;
aaa = p[p[ xi ] + yi ];
aba = p[p[ xi ] + inc(yi)];
baa = p[p[inc(xi)] + yi ];
bba = p[p[inc(xi)] + inc(yi)];
double x1, x2;
// The gradient function calculates the dot product between a
// pseudorandom gradient vector and the vector from the input
// coordinate to the 8 surrounding points in its unit cube.
// This is all then lerped together as a sort of weighted average
// based on the faded (u,v,w) values we made earlier.
x1 = lerp (
grad (aaa, xf , yf),
grad (baa, xf-1, yf),
u);
x2 = lerp (
grad (aba, xf , yf-1),
grad (bba, xf-1, yf-1),
u);
double result = (lerp (x1, x2, v) + 1) / 2;
assert (0 <= result);
assert (result <= 1);
assert (false == std :: isnan (result));
return result;
}
Here is the image it generates.
It's generated using this method:
int size=400;
int freq=10;
create_widget (size, size, [&] (int x, int y)
{
return noise (x*freq / float (size), y*freq / float (size));
});
What's causing those horizontal and vertical lines? I thought it might be an integer boundary issue, but that would predict freq artefacts across the whole image, so I guess it's something else.
Can you see what the mistake is?
There's probably a mistake in grad (the precedence of + is higher than ?:), which causes abrupt change of the (anyway incorrect) result on specific xf/yf/hash values.
return ((hash & 4) ? u : -u) + (hash & 8) ? v : -v;
( )

How to Convert D3DCOLORVALUE to delphi tcolor

I have a list of integers, obtained through C ++ code and which representing different D3DCOLORVALUE ambient, etc...
What is the correct method to obtain the same colors, from this numbers, in Delphi?.
For example, using a program in C ++ (Visual Studio 2012), by calling a library routine in C ++ (separate dll file) I can obtain the following values:
-1.44852785e-016 = 2770796799 (represent the color)
1.57844226e+11 = 1376977151 (represent the color)
-1.98938735e+034 = 4168431103 (represent the color)
3.39617733e+038 = 4294967295 (represent the color)
#Rudy Velthuis, The original code is: (some values contained in the array are those shown above)
int32_t index = ifcObject->indicesForFaces[0];
uint32_t ambient = ((int32_t*) vertices)[index * (vertexElementSize / sizeof(float)) + 6],
diffuse = ((int32_t*) vertices)[index * (vertexElementSize / sizeof(float)) + 7],
emissive = ((int32_t*) vertices)[index * (vertexElementSize / sizeof(float)) + 8],
specular = ((int32_t*) vertices)[index * (vertexElementSize / sizeof(float)) + 9];
Then in Delphi XE6 using
PInteger (#ColorsArray [index * sizeOfVertices + 6])^
I get the same values but, in delphi the colors are black or null. Sometimes negative numbers are obtained, it is understood that in C ++ it is possible to represent a color with a negative value but in delphi does not work.
How can I convert a color value, obtained in D3DCOLORVALUE format, to a Delphi's TColor?
That the values are used to obtain the colors of objects in
D3DMATERIAL9, D3DCOLORVALUE Ambient (Ambient color RGB)
FLOAT r;
FLOAT g;
FLOAT b;
FLOAT a;
This function make the color:
void SetColor(
D3DCOLORVALUE * iColor,
uint32_t color
)
{
iColor->r = (float) (color & ((unsigned int) 255 * 256 * 256 * 256)) / (256 * 256 * 256);
iColor->r /= 255.f;
iColor->g = (float) (color & (255 * 256 * 256)) / (256 * 256);
iColor->g /= 255.f;
iColor->b = (float) (color & (255 * 256)) / 256;
iColor->b /= 255.f;
iColor->a = (float) (color & (255));
iColor->a /= 255.f;
}
But in Delphi it does not work, the color obtained is wrong.
Comparison of colors with the #Dsm solution:
Left: Color obtained Right: Desired color
I have made a simple example to illustrate the differences:
The first color corresponds to the foot of the column and the second color corresponds to the column. The figure with the platform is the example with the library viewer, with the correct colors for that version and the figure on the right is an image of the watch in Visual Studio 2012 to show that the content of the array is the same and the value obtained with the cast is also the same but, when converting these numbers to colors they do not give the same result.
This looks like the original C++ extracts the colour knowing intimately the internal structure of an array of records. In your code you should not use (int32_t*) because that creates a pointer to a constant, and you just want to cast the float to a uint_32_t, so I think what you want to satisfy your test code is just
ambient := uint32_t(-1.44852785e-016);
diffuse := uint32_t(1.57844226e+11);
etc;
That doesn't compile in Delphi (invalid typecast), so instead you need to do something like
var
p : pointer;
iFloat : single;
iColour : TColor;
begin
iFloat := 1.57844226e+11;
p := #(iFloat);
iColour := TColor(p^);
diffuse := iColour;
end;
which gives a red colour.
Note that all your colours appear similar because you are taking the start of several similar addresses.
Expressed as a function this might become
function FloatToColor( const pVal : single ) : TColor;
var
p : pointer;
iFloat : single;
begin
iFloat := 1.57844226e+11;
p := #(iFloat);
Result := TColor(p^);
end;
Edit
Based on the fact that $FF appears in the wrong place, it occurred to me that these values might be CMYK format. In tests I found that it was a modified CMYK format - more a YMCK format, if you will, so to get the correct colours I had to reverse the roles of red and blue.
There is no true conversion from CMYK to RGB, but the following is approximate.
function CMYKtoRGB( const pValue : TColor) : TColor;
var
c,m,y,k,r,g,b : byte;
begin
c := GetCValue( pValue );
m := GetMValue( pValue );
y := GetYValue( pValue );
k := GetKValue( pValue );
//r := $FF xor c;
r := $FF - c;
b := $FF - y;
g := $FF - m;
if k <> $FF then
begin
k := $FF - k;
r := r * k;
g := g * k;
b := b * k;
end;
Result := RGB( b, g, r );
end;
function FloatToColor( const pVal : single ) : TColor;
var
p : pointer;
iFloat : single;
begin
iFloat := pVal;
p := #(iFloat);
Result := CMYKtoRGB(TColor(p^));
end;
Note that I use RGB( b, g, r) rather than the expected RGB( r, g, b) to account for the reversed colour order.

distance from given point to given ellipse

I have an ellipse, defined by Center Point, radiusX and radiusY, and I have a Point. I want to find the point on the ellipse that is closest to the given point. In the illustration below, that would be S1.
Now I already have code, but there is a logical error somewhere in it, and I seem to be unable to find it. I broke the problem down to the following code example:
#include <vector>
#include <opencv2/core/core.hpp>
#include <opencv2/highgui/highgui.hpp>
#include <math.h>
using namespace std;
void dostuff();
int main()
{
dostuff();
return 0;
}
typedef std::vector<cv::Point> vectorOfCvPoints;
void dostuff()
{
const double ellipseCenterX = 250;
const double ellipseCenterY = 250;
const double ellipseRadiusX = 150;
const double ellipseRadiusY = 100;
vectorOfCvPoints datapoints;
for (int i = 0; i < 360; i+=5)
{
double angle = i / 180.0 * CV_PI;
double x = ellipseRadiusX * cos(angle);
double y = ellipseRadiusY * sin(angle);
x *= 1.4;
y *= 1.4;
x += ellipseCenterX;
y += ellipseCenterY;
datapoints.push_back(cv::Point(x,y));
}
cv::Mat drawing = cv::Mat::zeros( 500, 500, CV_8UC1 );
for (int i = 0; i < datapoints.size(); i++)
{
const cv::Point & curPoint = datapoints[i];
const double curPointX = curPoint.x;
const double curPointY = curPoint.y * -1; //transform from image coordinates to geometric coordinates
double angleToEllipseCenter = atan2(curPointY - ellipseCenterY * -1, curPointX - ellipseCenterX); //ellipseCenterY * -1 for transformation to geometric coords (from image coords)
double nearestEllipseX = ellipseCenterX + ellipseRadiusX * cos(angleToEllipseCenter);
double nearestEllipseY = ellipseCenterY * -1 + ellipseRadiusY * sin(angleToEllipseCenter); //ellipseCenterY * -1 for transformation to geometric coords (from image coords)
cv::Point center(ellipseCenterX, ellipseCenterY);
cv::Size axes(ellipseRadiusX, ellipseRadiusY);
cv::ellipse(drawing, center, axes, 0, 0, 360, cv::Scalar(255));
cv::line(drawing, curPoint, cv::Point(nearestEllipseX,nearestEllipseY*-1), cv::Scalar(180));
}
cv::namedWindow( "ellipse", CV_WINDOW_AUTOSIZE );
cv::imshow( "ellipse", drawing );
cv::waitKey(0);
}
It produces the following image:
You can see that it actually finds "near" points on the ellipse, but it are not the "nearest" points. What I intentionally want is this: (excuse my poor drawing)
would you extent the lines in the last image, they would cross the center of the ellipse, but this is not the case for the lines in the previous image.
I hope you get the picture. Can anyone tell me what I am doing wrong?
Consider a bounding circle around the given point (c, d), which passes through the nearest point on the ellipse. From the diagram it is clear that the closest point is such that a line drawn from it to the given point must be perpendicular to the shared tangent of the ellipse and circle. Any other points would be outside the circle and so must be further away from the given point.
So the point you are looking for is not the intersection between the line and the ellipse, but the point (x, y) in the diagram.
Gradient of tangent:
Gradient of line:
Condition for perpedicular lines - product of gradients = -1:
When rearranged and substituted into the equation of your ellipse...
...this will give two nasty quartic (4th-degree polynomial) equations in terms of either x or y. AFAIK there are no general analytical (exact algebraic) methods to solve them. You could try an iterative method - look up the Newton-Raphson iterative root-finding algorithm.
Take a look at this very good paper on the subject:
http://www.spaceroots.org/documents/distance/distance-to-ellipse.pdf
Sorry for the incomplete answer - I totally blame the laws of mathematics and nature...
EDIT: oops, i seem to have a and b the wrong way round in the diagram xD
There is a relatively simple numerical method with better convergence than Newtons Method. I have a blog post about why it works http://wet-robots.ghost.io/simple-method-for-distance-to-ellipse/
This implementation works without any trig functions:
def solve(semi_major, semi_minor, p):
px = abs(p[0])
py = abs(p[1])
tx = 0.707
ty = 0.707
a = semi_major
b = semi_minor
for x in range(0, 3):
x = a * tx
y = b * ty
ex = (a*a - b*b) * tx**3 / a
ey = (b*b - a*a) * ty**3 / b
rx = x - ex
ry = y - ey
qx = px - ex
qy = py - ey
r = math.hypot(ry, rx)
q = math.hypot(qy, qx)
tx = min(1, max(0, (qx * r / q + ex) / a))
ty = min(1, max(0, (qy * r / q + ey) / b))
t = math.hypot(ty, tx)
tx /= t
ty /= t
return (math.copysign(a * tx, p[0]), math.copysign(b * ty, p[1]))
Credit to Adrian Stephens for the Trig-Free Optimization.
Here is the code translated to C# implemented from this paper to solve for the ellipse:
http://www.geometrictools.com/Documentation/DistancePointEllipseEllipsoid.pdf
Note that this code is untested - if you find any errors let me know.
//Pseudocode for robustly computing the closest ellipse point and distance to a query point. It
//is required that e0 >= e1 > 0, y0 >= 0, and y1 >= 0.
//e0,e1 = ellipse dimension 0 and 1, where 0 is greater and both are positive.
//y0,y1 = initial point on ellipse axis (center of ellipse is 0,0)
//x0,x1 = intersection point
double GetRoot ( double r0 , double z0 , double z1 , double g )
{
double n0 = r0*z0;
double s0 = z1 - 1;
double s1 = ( g < 0 ? 0 : Math.Sqrt(n0*n0+z1*z1) - 1 ) ;
double s = 0;
for ( int i = 0; i < maxIter; ++i ){
s = ( s0 + s1 ) / 2 ;
if ( s == s0 || s == s1 ) {break; }
double ratio0 = n0 /( s + r0 );
double ratio1 = z1 /( s + 1 );
g = ratio0*ratio0 + ratio1*ratio1 - 1 ;
if (g > 0) {s0 = s;} else if (g < 0) {s1 = s ;} else {break ;}
}
return s;
}
double DistancePointEllipse( double e0 , double e1 , double y0 , double y1 , out double x0 , out double x1)
{
double distance;
if ( y1 > 0){
if ( y0 > 0){
double z0 = y0 / e0;
double z1 = y1 / e1;
double g = z0*z0+z1*z1 - 1;
if ( g != 0){
double r0 = (e0/e1)*(e0/e1);
double sbar = GetRoot(r0 , z0 , z1 , g);
x0 = r0 * y0 /( sbar + r0 );
x1 = y1 /( sbar + 1 );
distance = Math.Sqrt( (x0-y0)*(x0-y0) + (x1-y1)*(x1-y1) );
}else{
x0 = y0;
x1 = y1;
distance = 0;
}
}
else // y0 == 0
x0 = 0 ; x1 = e1 ; distance = Math.Abs( y1 - e1 );
}else{ // y1 == 0
double numer0 = e0*y0 , denom0 = e0*e0 - e1*e1;
if ( numer0 < denom0 ){
double xde0 = numer0/denom0;
x0 = e0*xde0 ; x1 = e1*Math.Sqrt(1 - xde0*xde0 );
distance = Math.Sqrt( (x0-y0)*(x0-y0) + x1*x1 );
}else{
x0 = e0;
x1 = 0;
distance = Math.Abs( y0 - e0 );
}
}
return distance;
}
The following python code implements the equations described at "Distance from a Point to an Ellipse" and uses newton's method to find the roots and from that the closest point on the ellipse to the point.
Unfortunately, as can be seen from the example, it seems to only be accurate outside the ellipse. Within the ellipse weird things happen.
from math import sin, cos, atan2, pi, fabs
def ellipe_tan_dot(rx, ry, px, py, theta):
'''Dot product of the equation of the line formed by the point
with another point on the ellipse's boundary and the tangent of the ellipse
at that point on the boundary.
'''
return ((rx ** 2 - ry ** 2) * cos(theta) * sin(theta) -
px * rx * sin(theta) + py * ry * cos(theta))
def ellipe_tan_dot_derivative(rx, ry, px, py, theta):
'''The derivative of ellipe_tan_dot.
'''
return ((rx ** 2 - ry ** 2) * (cos(theta) ** 2 - sin(theta) ** 2) -
px * rx * cos(theta) - py * ry * sin(theta))
def estimate_distance(x, y, rx, ry, x0=0, y0=0, angle=0, error=1e-5):
'''Given a point (x, y), and an ellipse with major - minor axis (rx, ry),
its center at (x0, y0), and with a counter clockwise rotation of
`angle` degrees, will return the distance between the ellipse and the
closest point on the ellipses boundary.
'''
x -= x0
y -= y0
if angle:
# rotate the points onto an ellipse whose rx, and ry lay on the x, y
# axis
angle = -pi / 180. * angle
x, y = x * cos(angle) - y * sin(angle), x * sin(angle) + y * cos(angle)
theta = atan2(rx * y, ry * x)
while fabs(ellipe_tan_dot(rx, ry, x, y, theta)) > error:
theta -= ellipe_tan_dot(
rx, ry, x, y, theta) / \
ellipe_tan_dot_derivative(rx, ry, x, y, theta)
px, py = rx * cos(theta), ry * sin(theta)
return ((x - px) ** 2 + (y - py) ** 2) ** .5
Here's an example:
rx, ry = 12, 35 # major, minor ellipse axis
x0 = y0 = 50 # center point of the ellipse
angle = 45 # ellipse's rotation counter clockwise
sx, sy = s = 100, 100 # size of the canvas background
dist = np.zeros(s)
for x in range(sx):
for y in range(sy):
dist[x, y] = estimate_distance(x, y, rx, ry, x0, y0, angle)
plt.imshow(dist.T, extent=(0, sx, 0, sy), origin="lower")
plt.colorbar()
ax = plt.gca()
ellipse = Ellipse(xy=(x0, y0), width=2 * rx, height=2 * ry, angle=angle,
edgecolor='r', fc='None', linestyle='dashed')
ax.add_patch(ellipse)
plt.show()
Which generates an ellipse and the distance from the boundary of the ellipse as a heat map. As can be seen, at the boundary the distance is zero (deep blue).
Given an ellipse E in parametric form and a point P
the square of the distance between P and E(t) is
The minimum must satisfy
Using the trigonometric identities
and substituting
yields the following quartic equation:
Here's an example C function that solves the quartic directly and computes sin(t) and cos(t) for the nearest point on the ellipse:
void nearest(double a, double b, double x, double y, double *ecos_ret, double *esin_ret) {
double ax = fabs(a*x);
double by = fabs(b*y);
double r = b*b - a*a;
double c, d;
int switched = 0;
if (ax <= by) {
if (by == 0) {
if (r >= 0) { *ecos_ret = 1; *esin_ret = 0; }
else { *ecos_ret = 0; *esin_ret = 1; }
return;
}
c = (ax - r) / by;
d = (ax + r) / by;
} else {
c = (by + r) / ax;
d = (by - r) / ax;
switched = 1;
}
double cc = c*c;
double D0 = 12*(c*d + 1); // *-4
double D1 = 54*(d*d - cc); // *4
double D = D1*D1 + D0*D0*D0; // *16
double St;
if (D < 0) {
double t = sqrt(-D0); // *2
double phi = acos(D1 / (t*t*t));
St = 2*t*cos((1.0/3)*phi); // *2
} else {
double Q = cbrt(D1 + sqrt(D)); // *2
St = Q - D0 / Q; // *2
}
double p = 3*cc; // *-2
double SS = (1.0/3)*(p + St); // *4
double S = sqrt(SS); // *2
double q = 2*cc*c + 4*d; // *2
double l = sqrt(p - SS + q / S) - S - c; // *2
double ll = l*l; // *4
double ll4 = ll + 4; // *4
double esin = (4*l) / ll4;
double ecos = (4 - ll) / ll4;
if (switched) {
double t = esin;
esin = ecos;
ecos = t;
}
*ecos_ret = copysign(ecos, a*x);
*esin_ret = copysign(esin, b*y);
}
Try it online!
You just need to calculate the intersection of the line [P1,P0] to your elipse which is S1.
If the line equeation is:
and the elipse equesion is:
than the values of S1 will be:
Now you just need to calculate the distance between S1 to P1 , the formula (for A,B points) is:
I've solved the distance issue via focal points.
For every point on the ellipse
r1 + r2 = 2*a0
where
r1 - Euclidean distance from the given point to focal point 1
r2 - Euclidean distance from the given point to focal point 2
a0 - semimajor axis length
I can also calculate the r1 and r2 for any given point which gives me another ellipse that this point lies on that is concentric to the given ellipse. So the distance is
d = Abs((r1 + r2) / 2 - a0)
As propposed by user3235832
you shall solve quartic equation to find the normal to the ellipse (https://www.mathpages.com/home/kmath505/kmath505.htm). With good initial value only few iterations are needed (I use it myself). As an initial value I use S1 from your picture.
The fastest method I guess is
http://wwwf.imperial.ac.uk/~rn/distance2ellipse.pdf
Which has been mentioned also by Matt but as he found out the method doesn't work very well inside of ellipse.
The problem is the theta initialization.
I proposed an stable initialization:
Find the intersection of ellipse and horizontal line passing the point.
Find the other intersection using vertical line.
Choose the one that is closer the point.
Calculate the initial angle based on that point.
I got good results with no issue inside and outside:
As you can see in the following image it just iterated about 3 times to reach 1e-8. Close to axis it is 1 iteration.
The C++ code is here:
double initialAngle(double a, double b, double x, double y) {
auto abs_x = fabs(x);
auto abs_y = fabs(y);
bool isOutside = false;
if (abs_x > a || abs_y > b) isOutside = true;
double xd, yd;
if (!isOutside) {
xd = sqrt((1.0 - y * y / (b * b)) * (a * a));
if (abs_x > xd)
isOutside = true;
else {
yd = sqrt((1.0 - x * x / (a * a)) * (b * b));
if (abs_y > yd)
isOutside = true;
}
}
double t;
if (isOutside)
t = atan2(a * y, b * x); //The point is outside of ellipse
else {
//The point is inside
if (xd < yd) {
if (x < 0) xd = -xd;
t = atan2(y, xd);
}
else {
if (y < 0) yd = -yd;
t = atan2(yd, x);
}
}
return t;
}
double distanceToElipse(double a, double b, double x, double y, int maxIter = 10, double maxError = 1e-5) {
//std::cout <<"p="<< x << "," << y << std::endl;
auto a2mb2 = a * a - b * b;
double t = initialAngle(a, b, x, y);
auto ct = cos(t);
auto st = sin(t);
int i;
double err;
for (i = 0; i < maxIter; i++) {
auto f = a2mb2 * ct * st - x * a * st + y * b * ct;
auto fp = a2mb2 * (ct * ct - st * st) - x * a * ct - y * b * st;
auto t2 = t - f / fp;
err = fabs(t2 - t);
//std::cout << i + 1 << " " << err << std::endl;
t = t2;
ct = cos(t);
st = sin(t);
if (err < maxError) break;
}
auto dx = a * ct - x;
auto dy = b * st - y;
//std::cout << a * ct << "," << b * st << std::endl;
return sqrt(dx * dx + dy * dy);
}