indexing description: "[ Surface representing video screen. Use `EM_SHARED_SUBSYSTEMS.video_subsystem.video_surface' to access the only instance of this class. ]" date: "$Date$" revision: "$Revision$" class EM_VIDEO_SURFACE inherit EM_SURFACE redefine blit_surface, blit_surface_part, clear end GL_FUNCTIONS -- for gl_bind_texture (Not the whole system changed to em3d) export {NONE} all end EMGL_SETTINGS export {NONE} all end EMGL_VIEW export {NONE} all end EMGL_DRAW export {NONE} all end EMGL_BASIC_RENDERER export {NONE} all end KL_SHARED_OPERATING_SYSTEM export {NONE} all end create {EM_VIDEO_SUBSYSTEM} make feature {NONE} -- Initialisation make (a_pointer: POINTER; an_opengl_flag: BOOLEAN) is -- Initialise surface with `a_pointer'. do make_from_pointer (a_pointer) is_opengl_enabled := an_opengl_flag if is_opengl_enabled then set_clear_color (create {EM_COLOR}.make_black) end end feature -- Status report is_opengl_enabled: BOOLEAN -- Is OpenGL enabled? is_auto_opengl_blitting_enabled: BOOLEAN -- Is automatic activation and deactivation of OpenGL blitting enabled? is_opengl_blitting_enabled: BOOLEAN -- Is blitting of surfaces with OpenGL enabled? feature -- Status setting enable_auto_opengl_blitting is -- Enable automatic activation of OpenGL blitting. do is_auto_opengl_blitting_enabled := True ensure auto_opengl_blitting_enabled: is_auto_opengl_blitting_enabled end disable_auto_opengl_blitting is -- Disable automatic activation of OpenGL blitting. do is_auto_opengl_blitting_enabled := False ensure auto_opengl_blitting_disabled: not is_auto_opengl_blitting_enabled end enable_opengl_blitting is -- Enable blitting of surfaces in OpenGL. do if not is_opengl_blitting_enabled then emgl_push_attrib ( Em_gl_enable_bit | Em_gl_color_buffer_bit ) emgl_disable ( Em_gl_depth_test ) emgl_disable ( Em_gl_cull_face ) emgl_enable ( Em_gl_texture_2d ) -- This allows alpha blending of 2D textures with the scene emgl_enable (Em_gl_blend) emgl_blend_func (Em_gl_src_alpha, Em_gl_one_minus_src_alpha) emgl_viewport ( 0, 0, width, height ) -- Set perspective emgl_matrix_mode ( Em_gl_projection ) emgl_push_matrix emgl_load_identity emgl_ortho ( 0, width, height, 0, 0, 1 ) emgl_matrix_mode ( Em_gl_modelview ) emgl_push_matrix emgl_load_identity emgl_tex_envf ( Em_gl_texture_env_mode, Em_gl_replace) is_opengl_blitting_enabled := True end ensure opengl_blitting_enabled: is_opengl_blitting_enabled end disable_opengl_blitting is -- Disable blitting of surfaces in OpenGL. do if is_opengl_blitting_enabled then emgl_matrix_mode ( Em_gl_projection ) emgl_pop_matrix emgl_matrix_mode ( Em_gl_modelview ) emgl_pop_matrix emgl_pop_attrib is_opengl_blitting_enabled := False end ensure opengl_blitting_disabled: not is_opengl_blitting_enabled end feature -- Element change set_clear_color (a_color: EM_COLOR) is -- Set OpenGL clear color to `a_color'. require opengl_enabled : is_opengl_enabled = true a_color_not_void: a_color /= Void do emgl_clear_color (a_color.red / 255, a_color.green / 255, a_color.blue / 255, a_color.alpha / 255) end feature -- Miscellaneous toggle_fullscreen is -- Toggle fullscreen display. -- Note: This is only available on X11. -- TODO: This can crash sometimes leaving the -- Xserver in the fullscreen video mode. Maybe a timeout -- should be used here. do if Operating_system.is_unix then if sdl_wm_toggle_full_screen_external (item) = 0 then Error_handler.raise_warning (Error_handler.Em_error_toggle_fullscreen, []) end else Error_handler.raise_warning (Error_handler.Em_error_toggle_fullscreen_not_supported, []) end end feature -- Drawing redraw is -- Redraw display. do if is_opengl_enabled then sdl_gl_swap_buffers_external else if sdl_flip_external (item) < 0 then Error_handler.raise_warning (Error_handler.Em_error_redraw_surface, []) end end end clear is -- Clear `Current' surface with black color. do if is_opengl_enabled then emgl_clear (Em_gl_color_buffer_bit) else Precursor end end blit_surface (a_surface: EM_SURFACE; a_x: INTEGER; a_y: INTEGER) is -- Blit `a_surface' at `a_x' and `a_y' onto `Current'. do if is_opengl_enabled then gl_blit_surface_part (a_surface, 0, 0, a_surface.width, a_surface.height, a_x, a_y) else Precursor {EM_SURFACE} (a_surface, a_x, a_y) end end blit_surface_part (a_surface: EM_SURFACE; a_x, a_y, a_width, a_height: INTEGER; a_dest_x, a_dest_y: INTEGER) is -- Blit `a_surface' the part from `a_x' and `a_y' to `a_width' and `a_height' onto `Current' at `dest_x', `dest_y'. do if is_opengl_enabled then gl_blit_surface_part (a_surface, a_x, a_y, a_width, a_height, a_dest_x, a_dest_y) else Precursor {EM_SURFACE} (a_surface, a_x, a_y, a_width, a_height, a_dest_x, a_dest_y) end end feature {NONE} -- Implementation gl_blit_surface_part (a_surface: EM_SURFACE; an_x: INTEGER; an_y: INTEGER; a_width: INTEGER; a_height: INTEGER; dest_x: INTEGER; dest_y: INTEGER) is -- Blit `a_surface' in OpenGL mode to screen. local a_texture: GL_TEXTURE tex_start_x: DOUBLE tex_end_x: DOUBLE tex_start_y: DOUBLE tex_end_y: DOUBLE auto_activated: BOOLEAN do if is_auto_opengl_blitting_enabled and not is_opengl_blitting_enabled then enable_opengl_blitting auto_activated := True end a_texture := a_surface.texture tex_start_x := an_x / a_texture.width tex_start_y := an_y / a_texture.height tex_end_x := (an_x + a_width) / a_texture.width tex_end_y := (an_y + a_height) / a_texture.height gl_bind_texture (Em_gl_texture_2d, a_texture.id) emgl_begin (Em_gl_quads) emgl_tex_coord2f (tex_start_x, tex_start_y) emgl_vertex2d (dest_x, dest_y) emgl_tex_coord2f (tex_start_x, tex_end_y) emgl_vertex2d (dest_x, dest_y + a_height) emgl_tex_coord2f (tex_end_x, tex_end_y ) emgl_vertex2d (dest_x + a_width, dest_y + a_height) emgl_tex_coord2f (tex_end_x, tex_start_y) emgl_vertex2d (dest_x + a_width, dest_y) emgl_end if auto_activated then disable_opengl_blitting end end end