1. with GLU; 
  2.  
  3. with GLOBE_3D.Math; 
  4.  
  5. package body GLOBE_3D.Portals is 
  6.  
  7.    -- Cheap but fast portal method with rectangles. 
  8.  
  9.    procedure Intersect (A, B : Rectangle; C : out Rectangle; non_empty : out Boolean) is 
  10.  
  11.    begin 
  12.       C := (X1 => Integer'Max (A.X1, B.X1), 
  13.             X2 => Integer'Min (A.X2, B.X2), 
  14.             Y1 => Integer'Max (A.Y1, B.Y1), 
  15.             Y2 => Integer'Min (A.Y2, B.Y2)); 
  16.       non_empty := C.X1 <= C.X2 and then C.Y1 <= C.Y2; 
  17.    end Intersect; 
  18.  
  19.    procedure Projection (P       :     Point_3D; 
  20.                          x, y    : out Integer; 
  21.                          success : out Boolean) is 
  22.  
  23.       model, proj : GLU.Matrix_Double; 
  24.       view        : GLU.Viewport_Rec; 
  25.       uu, vv, ww  : GL.Double; 
  26.  
  27.       z_a : constant := 0.0001; 
  28.       z_z : constant := 1.0 - z_a; 
  29.       -- GLU sometimes gives fuzzy (e.g. -3612 instead of +4243) 
  30.       -- x, y coordinates, with z outside ]0;1[; looks like a wrap-around 
  31.       -- of large integer values 
  32.  
  33.    begin 
  34.       GLU.Get (GL.MODELVIEW_MATRIX, model); 
  35.       GLU.Get (GL.PROJECTION_MATRIX, proj); 
  36.       GLU.Get (view); 
  37.       GLU.Project (P (0), P (1), P (2), model, proj, view, uu, vv, ww, success); 
  38.       success := success and then ww > z_a and then ww < z_z; 
  39.       if success then 
  40.          x := Integer (uu); 
  41.          y := Integer (vv); 
  42.          -- info_a_pnt (0) := (uu, vv, ww); 
  43.       else 
  44.          x := -1; 
  45.          y := -1; 
  46.       end if; 
  47.    end Projection; 
  48.  
  49.    procedure Find_bounding_box (o       :     Object_3D'Class; 
  50.                                 face    :     Positive; 
  51.                                 b       : out Rectangle; 
  52.                                 success : out Boolean) is 
  53.  
  54.       x, y : Integer; 
  55.       proj_success : Boolean; 
  56.       use GLOBE_3D.Math; 
  57.  
  58.    begin 
  59.       b := (X1 | Y1 => Integer'Last, X2 | Y2 => Integer'First); 
  60.  
  61.       for sf in reverse 1 .. o.Face_Invariant (face).last_edge loop 
  62.          Projection (o.Point (o.Face_Invariant (face).P_compact (sf)) + o.Centre, 
  63.                      x, y, 
  64.                      proj_success); 
  65.          if proj_success then 
  66.             -- info_a_pnt (sf) := info_a_pnt (0); 
  67.             b := (X1 => Integer'Min (b.X1, x), 
  68.                   X2 => Integer'Max (b.X2, x), 
  69.                   Y1 => Integer'Min (b.Y1, y), 
  70.                   Y2 => Integer'Max (b.Y2, y)); 
  71.          else 
  72.             success := False; 
  73.             return; -- we cannot project all edges of the polygon, then fail. 
  74.          end if; 
  75.       end loop; 
  76.       success := True; 
  77.    end Find_bounding_box; 
  78.  
  79.    procedure Draw_boundary (main, clip : Rectangle) is 
  80.  
  81.       z : constant := 0.0; 
  82.  
  83.       procedure Line (x1, y1, x2, y2 : Integer) is 
  84.  
  85.       begin 
  86.          Vertex (GL.Double (x1), GL.Double (y1), z); 
  87.          Vertex (GL.Double (x2), GL.Double (y2), z); 
  88.       end Line; 
  89.  
  90.       procedure Frame_Rect (x1, y1, x2, y2 : Integer) is 
  91.  
  92.       begin 
  93.          Line (x1, y1, x2, y1); 
  94.          Line (x2, y1, x2, y2); 
  95.          Line (x2, y2, x1, y2); 
  96.          Line (x1, y2, x1, y1); 
  97.       end Frame_Rect; 
  98.  
  99.       rect : Rectangle; 
  100.  
  101.    begin 
  102.       GL.Disable (GL.LIGHTING); 
  103.       GL.Disable (GL.TEXTURE_2D); 
  104.       -- GL.Disable (GL.DEPTH_TEST); -- eeerh, @#*$!, doesn't work! 
  105.       -- Workaround, we make the rectangle 1 pixel smaller 
  106.       rect := (clip.X1 + 1, clip.Y1 + 1, clip.X2 - 1, clip.Y2 - 1); 
  107.       -- Push current matrix mode and viewport attributes. 
  108.       GL.PushAttrib (GL.TRANSFORM_BIT + GL.VIEWPORT_BIT); 
  109.       GL.MatrixMode (GL.PROJECTION); 
  110.       GL.PushMatrix; 
  111.       GL.LoadIdentity; 
  112.       GL.Ortho (ortho_left   => 0.0, 
  113.                 ortho_right  => GL.Double (main.X2 - 1), 
  114.                 bottom       => 0.0, 
  115.                 top          => GL.Double (main.Y2 - 1), 
  116.                 near_val     => -1.0, 
  117.                 far_val      => 1.0); 
  118.  
  119.       GL.MatrixMode (GL.MODELVIEW); 
  120.       GL.PushMatrix; 
  121.       GL.LoadIdentity; 
  122.  
  123.       -- A green rectangle to signal the clipping area 
  124.       GL.Color (0.1, 1.0, 0.1, 1.0); 
  125.       GL_Begin (GL.LINES); 
  126.       Frame_Rect (rect.X1,  rect.Y1,  rect.X2,  rect.Y2); 
  127.       GL_End; 
  128.       -- A red cross across the area 
  129.       GL.Color (1.0, 0.1, 0.1, 1.0); 
  130.       GL_Begin (GL.LINES); 
  131.       Line (clip.X1, clip.Y1, clip.X2, clip.Y2); 
  132.       Line (clip.X2, clip.Y1, clip.X1, clip.Y2); 
  133.       GL_End; 
  134.  
  135.       GL.PopMatrix; 
  136.       GL.MatrixMode (GL.PROJECTION); 
  137.       GL.PopMatrix; 
  138.       GL.PopAttrib; 
  139.       GL.Enable (GL.LIGHTING); 
  140.       -- GL.Enable (GL.DEPTH_TEST); 
  141.  
  142.    end Draw_boundary; 
  143.  
  144. end GLOBE_3D.Portals;