with ada.Text_IO, ada.Exceptions; package body openGL.Camera is use math.Algebra.linear, math.Algebra.linear.d3, ada.Text_IO; --------- -- Forge -- procedure define (Self : in out Item) is begin Self.Culler .define; Self.Impostorer.define; Self.world_Transform := Identity_4x4; Self. view_Transform := Identity_4x4; Self.Viewport := (Min => [0, 0], Max => [0, 0]); end define; procedure destroy (Self : in out Item) is begin Self.cull_Engine.stop; end destroy; -------------- -- Attributes -- function to_World_Site (Self : in Item; Window_Site : in math.Vector_3) return math.Vector_3 is perspective_Transform : constant math.Matrix_4x4 := to_Perspective (FoVy => Self.FoVy, Aspect => Self.Aspect, zNear => Self.near_Plane_Distance, zFar => Self. far_Plane_Distance); Viewport : constant Rectangle := Self.Viewport; Position_window_space : constant Vector_3 := [Window_Site (1), Real (Viewport.Max (2)) - Window_Site (2), Window_Site (3)]; Site_world_space : constant Vector_3 := unProject (Position_window_space, Model => Self.view_Transform, Projection => perspective_Transform, Viewport => Viewport); begin return Site_world_space; end to_World_Site; procedure Site_is (Self : in out Item; now : in math.Vector_3) is begin Self.world_Transform := to_transform_Matrix ((Self.Spin, now)); Self.update_View_Transform; end Site_is; function Site (Self : in Item) return math.Vector_3 is begin return get_Translation (Self.world_Transform); end Site; procedure Position_is (Self : in out Item'Class; Site : in math.Vector_3; Spin : in math.Matrix_3x3) is begin Self.world_Transform := to_transform_Matrix ((Spin, Site)); Self.update_View_Transform; end Position_is; procedure Spin_is (Self : in out Item'Class; now : in math.Matrix_3x3) is begin set_Rotation (Self.world_Transform, to => now); Self.update_View_Transform; end Spin_is; function Spin (Self : in Item'Class) return math.Matrix_3x3 is begin return get_Rotation (Self.world_Transform); end Spin; function World_Transform (Self : in Item) return math.Matrix_4x4 is begin return Self.world_Transform; end World_Transform; function FoVy (Self : in Item'Class) return math.Degrees is begin return Self.FoVy; end FOVy; procedure FoVy_is (Self : in out Item'Class; Now : in math.Degrees) is begin Self.FoVy := Now; end FoVy_is; function Aspect (Self : in Item'Class) return math.Real is begin return Self.Aspect; end Aspect; procedure Aspect_is (Self : in out Item'Class; now : in math.Real) is begin Self.Aspect := now; end Aspect_is; function near_Plane_Distance (Self : in Item'Class) return math.Real is begin return Self.near_Plane_Distance; end near_Plane_Distance; procedure near_Plane_Distance_is (Self : in out Item'Class; now : in math.Real) is begin Self.near_Plane_Distance := now; end near_Plane_Distance_is; function far_Plane_Distance (Self : in Item'Class) return math.Real is begin return Self.far_Plane_Distance; end far_Plane_Distance; procedure far_Plane_Distance_is (Self : in out Item'Class; now : in math.Real) is begin Self.far_Plane_Distance := now; end far_Plane_Distance_is; function view_Transform (Self : in Item'Class) return math.Matrix_4x4 is begin return Self.view_Transform; end view_Transform; function projection_Transform (Self : in Item'Class) return math.Matrix_4x4 is begin return Self.projection_Transform; end projection_Transform; procedure Viewport_is (Self : in out Item'Class; Width, Height : in Positive) is use real_Functions; half_FoV_max : Radians := to_Radians (0.5 * Self.FoVy); Tan_of_half_FoV_max : constant Real := Tan (half_FoV_max); begin Self.Viewport.Min (1) := 0; Self.Viewport.Min (2) := 0; Self.Viewport.Max (1) := Width - 1; Self.Viewport.Max (2) := Height - 1; Self.Aspect := Real (Width) / Real (Height); Self.near_plane_Height := Self.near_plane_Distance * Tan_of_half_FoV_max; Self.near_plane_Width := Self.near_plane_Height * Self.Aspect; Self.far_plane_Height := Self.far_plane_Distance * Tan_of_half_FoV_max; Self.far_plane_Width := Self.far_plane_Height * Self.Aspect; if Self.Aspect > 1.0 then -- X side angle broader than y side angle. half_FoV_max := arcTan (Self.aspect * Tan_of_half_FoV_max); -- TODO: 'half_FoV_max' is not used after here. Why is it set ? end if; Self.projection_Transform := to_Perspective (FoVy => Self.FoVy, Aspect => Self.Aspect, zNear => Self.near_Plane_Distance, zFar => Self. far_Plane_Distance); end Viewport_is; function Viewport (Self : in Item) return linear_Algebra_3d.Rectangle is begin return Self.Viewport; end Viewport; procedure Renderer_is (Self : in out Item; now : in Renderer.lean.view) is begin Self.Renderer := now; end Renderer_is; function cull_completed (Self : in Item) return Boolean is begin return Boolean (Self.cull_Completed); end cull_completed; procedure disable_cull (Self : in out Item) is begin Self.is_Culling := False; end disable_cull; function vanish_Point_Size_min (Self : in Item'Class) return Real is begin return Self.Culler.vanish_Point_Size_min; end vanish_Point_Size_min; procedure vanish_Point_Size_min_is (Self : in out Item'Class; now : in Real) is begin Self.Culler.vanish_Point_Size_min_is (now); end vanish_Point_Size_min_is; -- Impostors -- function Impostor_Size_min (Self : in Item) return Real is begin return Self.Impostorer.Impostor_Size_min; end Impostor_Size_min; procedure Impostor_Size_min_is (Self : in out Item; now : in Real) is begin Self.Impostorer.Impostor_Size_min_is (now); end Impostor_Size_min_is; procedure allow_Impostors (Self : in out Item; now : in Boolean := True) is begin Self.Impostors_allowed := now; end allow_Impostors; ---------- -- Engine -- task body cull_Engine is Done : Boolean := False; culling : Boolean; all_Visuals : openGL.Visual.views (1 .. 20_000); all_Visuals_last : Natural; begin loop select accept stop do Done := True; end stop; or accept cull (the_Visuals : in Visual.views; do_cull : in Boolean) do all_Visuals (the_Visuals'Range) := the_Visuals; all_visuals_Last := the_Visuals'Last; culling := do_cull; Self.Cull_completed := False; end cull; end select; exit when Done; declare function get_Visuals return Visual.views is begin if culling then return Self.Culler.cull (the_Visuals => all_Visuals (1 .. all_Visuals_last), Camera_Frustum => Self.current_Planes, Camera_Site => Self.Site); else return all_Visuals (1 .. all_visuals_Last); end if; end get_Visuals; the_Visuals : Visual.views := get_Visuals; begin if Self.Impostors_allowed then Self.Impostorer.Renderer_is (Self.Renderer); Self.Impostorer.substitute (the_Visuals, Camera => Self); end if; Self.Renderer.queue_Visuals (the_Visuals, Self); Self.Cull_completed := True; end; end loop; Self.Impostorer.destruct; exception when E : others => new_Line; put_Line ("Unhandled exception in openGL camera Cull engine."); put_Line (ada.Exceptions.Exception_Information (E)); end cull_Engine; -------------- -- Operations -- procedure render (Self : in out Item; Visuals : in Visual.views; to : in Surface.view := null) is pragma Unreferenced (To); -- TODO: Finish using surfaces. begin Self.cull_Engine.cull (Visuals, do_cull => Self.is_Culling); end render; function current_Planes (Self : in Item) return openGL.Frustum.Plane_array is use openGL.Frustum; the_Planes : Frustum.Plane_array; Projection : constant Matrix_4x4 := Self.projection_Transform; Model : constant Matrix_4x4 := Self.view_Transform; Clip : constant Matrix_4x4 := Model * Projection; begin -- Extract the Right plane. -- the_Planes (Right)(1) := clip (1,4) - clip (1,1); the_Planes (Right)(2) := clip (2,4) - clip (2,1); the_Planes (Right)(3) := clip (3,4) - clip (3,1); the_Planes (Right)(4) := clip (4,4) - clip (4,1); -- Extract the Left plane. -- the_Planes (Left)(1) := clip (1,4) + clip (1,1); the_Planes (Left)(2) := clip (2,4) + clip (2,1); the_Planes (Left)(3) := clip (3,4) + clip (3,1); the_Planes (Left)(4) := clip (4,4) + clip (4,1); -- Extract the Low plane. -- the_Planes (Low)(1) := clip (1,4) + clip (1,2); the_Planes (Low)(2) := clip (2,4) + clip (2,2); the_Planes (Low)(3) := clip (3,4) + clip (3,2); the_Planes (Low)(4) := clip (4,4) + clip (4,2); -- Extract the High plane. -- the_Planes (High)(1) := clip (1,4) - clip (1,2); the_Planes (High)(2) := clip (2,4) - clip (2,2); the_Planes (High)(3) := clip (3,4) - clip (3,2); the_Planes (High)(4) := clip (4,4) - clip (4,2); -- Extract the Far plane. -- the_Planes (Far)(1) := clip (1,4) - clip (1,3); the_Planes (Far)(2) := clip (2,4) - clip (2,3); the_Planes (Far)(3) := clip (3,4) - clip (3,3); the_Planes (Far)(4) := clip (4,4) - clip (4,3); -- Extract the Near plane. -- the_Planes (Near)(1) := clip (1,4) + clip (1,3); the_Planes (Near)(2) := clip (2,4) + clip (2,3); the_Planes (Near)(3) := clip (3,4) + clip (3,3); the_Planes (Near)(4) := clip (4,4) + clip (4,3); normalise (the_Planes); return the_Planes; end current_Planes; procedure update_View_Transform (Self : in out Item) is begin Self.view_Transform := inverse_Transform (Self.world_Transform); end update_View_Transform; end openGL.Camera;