Source file : globe_3d-portals.adb
with GL.Simple_text, GL.Math, GLU;
package body GLOBE_3D.Portals is
-- Cheap but fast portal method with rectangles.
procedure Intersect (A,B: Rectangle; C: out Rectangle; non_empty: out Boolean) is
begin
C.X1:= Integer'Max(A.X1,B.X1);
C.X2:= Integer'Min(A.X2,B.X2);
C.Y1:= Integer'Max(A.Y1,B.Y1);
C.Y2:= Integer'Min(A.Y2,B.Y2);
non_empty:= C.X1 <= C.X2 and C.Y1 <= C.Y2;
end Intersect;
procedure Projection(
P : in Point_3D;
x,y : out Integer;
success: out Boolean
)
is
model, proj: GLU.doubleMatrix;
view: GLU.viewPortRec;
uu,vv,ww: GL.Double;
use GL;
z_a: constant:= 0.0001;
z_z: constant:= 1.0 - z_a;
-- GLU sometimes gives fuzzy (e.g. -3612 instead of +4243)
-- x,y coordinates, with z outside ]0;1[; looks like a wrap-around
-- of large integer values
begin
GLU.Get( GL.MODELVIEW_MATRIX, model );
GLU.Get( GL.PROJECTION_MATRIX, proj );
GLU.Get( view );
GLU.Project( P(0),P(1),P(2), model, proj, view, uu, vv, ww, success );
success:=
success
and then
ww > z_a
and then
ww < z_z
;
if success then
x:= Integer(uu);
y:= Integer(vv);
-- info_a_pnt(0):= (uu,vv,ww);
else
x:= -1;
y:= -1;
end if;
end Projection;
procedure Find_bounding_box(
o : Object_3D'Class;
face : Positive;
b : out Rectangle;
success: out Boolean
)
is
x,y: Integer;
proj_success: Boolean;
use GL.Math;
begin
b:= ( X1|Y1=> Integer'Last, X2|Y2=> Integer'First );
for sf in reverse 1 .. o.face_internal(face).last_edge loop
Projection(
o.point(o.face_internal(face).P_compact(sf))+o.centre,
x, y,
proj_success
);
if proj_success then
-- info_a_pnt(sf):= info_a_pnt(0);
b.X1:= Integer'Min(b.X1, x);
b.X2:= Integer'Max(b.X2, x);
b.Y1:= Integer'Min(b.Y1, y);
b.Y2:= Integer'Max(b.Y2, y);
else
success:= False;
return; -- we cannot project all edges of the polygon, then fail.
end if;
end loop;
success:= True;
end Find_bounding_box;
procedure Draw_boundary( main, clip: Rectangle; portal_depth: Natural:= 0 ) is
use GL, REF;
z: constant := 0.0;
procedure Line(x1,y1,x2,y2: Integer) is
begin
Vertex(GL.Double(x1),GL.Double(y1), z);
Vertex(GL.Double(x2),GL.Double(y2), z);
end Line;
procedure Frame_Rect(x1,y1,x2,y2: Integer) is
begin
Line(x1,y1,x2,y1);
Line(x2,y1,x2,y2);
Line(x2,y2,x1,y2);
Line(x1,y2,x1,y1);
end Frame_Rect;
rect: Rectangle;
val: constant Real:= 0.3 + 0.7 * Exp(-GL.Double(portal_depth));
text_size: constant:= 12.5;
begin
GL.Disable( GL.LIGHTING );
GL.Disable( GL.TEXTURE_2D );
-- GL.Disable( GL.DEPTH_TEST ); -- eeerh, @#*$!, doesn't work!
-- Workaround, we make the rectangle 1 pixel smaller
rect:= (clip.X1+1,clip.Y1+1,clip.X2-1,clip.Y2-1);
-- Push current matrix mode and viewport attributes.
GL.PushAttrib(GL.TRANSFORM_BIT + GL.VIEWPORT_BIT);
GL.MatrixMode(GL.PROJECTION);
GL.PushMatrix;
GL.LoadIdentity;
GL.Ortho(
left => 0.0,
right => GL.Double(main.X2-1),
bottom => 0.0,
top => GL.Double(main.Y2-1),
near_val => -1.0,
far_val => 1.0
);
GL.MatrixMode(GL.MODELVIEW);
GL.PushMatrix;
GL.LoadIdentity;
-- Portal label
GL.Simple_text.Text_output(
(GL.Double(clip.X1), GL.Double(clip.Y2) - text_size, 0.0),
"Portal depth:" & Integer'Image(portal_depth),
(0.7, 0.7, val, 0.9),
text_size,
GL.Simple_text.Sans_Serif
);
-- A green rectangle to signal the clipping area
GL.Color( 0.1, val, 0.1, 1.0);
GL_Begin(GL.LINES);
Frame_Rect( rect.X1, rect.Y1, rect.X2, rect.Y2 );
GL_End;
-- A red cross across the area
GL.Color( val, 0.1, 0.1, 1.0);
GL_Begin(GL.LINES);
Line( clip.X1,clip.Y1,clip.X2,clip.Y2 );
Line( clip.X2,clip.Y1,clip.X1,clip.Y2 );
GL_End;
GL.PopMatrix;
GL.MatrixMode(GL.PROJECTION);
GL.PopMatrix;
GL.PopAttrib;
GL.Enable( GL.LIGHTING );
-- GL.Enable( GL.DEPTH_TEST );
end Draw_boundary;
end GLOBE_3D.Portals;
GLOBE_3D: Ada library for real-time 3D rendering.
Ada programming.