actually seperate act from render
This commit is contained in:
86
main.ml
86
main.ml
@ -363,19 +363,20 @@ module Display = struct
|
||||
(* current window state to be passed to window renderer *)
|
||||
type state =
|
||||
{ box: box2
|
||||
; (* This is cannonically box within which the next element should draw *)
|
||||
time: float
|
||||
; events: Event.events
|
||||
(* This is cannonically box within which the next element should draw *)
|
||||
; time: float
|
||||
; wall: Wall.renderer }
|
||||
|
||||
(* the box2 here is cannonically the place the returner drew
|
||||
(the Wall.image extents) *)
|
||||
type image = box2 * Wall.image
|
||||
|
||||
let empty : image = (Box2.empty, Image.empty)
|
||||
let image_empty : image = (Box2.empty, Image.empty)
|
||||
|
||||
type pane = state -> state * image
|
||||
|
||||
let pane_empty s = (s, image_empty)
|
||||
|
||||
type frame =
|
||||
{ sdl_win: Sdl.window
|
||||
; gl: Sdl.gl_context
|
||||
@ -410,7 +411,7 @@ module Display = struct
|
||||
Ok {sdl_win; gl; wall; quit= false; fullscreen= false} )
|
||||
~cleanup:(fun () -> Sdl.destroy_window sdl_win)
|
||||
|
||||
let display_frame frame render =
|
||||
let get_events () =
|
||||
(* create and fill event list *)
|
||||
let ev = Sdl.Event.create () in
|
||||
let el = ref [`None] in
|
||||
@ -419,8 +420,13 @@ module Display = struct
|
||||
if e != `None then el := !el @ [e]
|
||||
(* HACK? *)
|
||||
done ;
|
||||
(* Filter the events *)
|
||||
el :=
|
||||
!el
|
||||
|
||||
let last_pane = ref pane_empty
|
||||
|
||||
let display_frame frame actor =
|
||||
let events =
|
||||
(* Handle relevant events *)
|
||||
List.filter_map
|
||||
(function
|
||||
| `Quit ->
|
||||
@ -438,39 +444,32 @@ module Display = struct
|
||||
else Sdl.Window.windowed )
|
||||
: _ result ) ) ;
|
||||
None
|
||||
| `Key_up a -> Some (`Key_up a)
|
||||
| `Key_down a -> Some (`Key_down a)
|
||||
| `Mouse a -> Some (`Mouse a)
|
||||
| a -> Some a (*| a -> Some a*) )
|
||||
!el ;
|
||||
if List.length !el > 0 then (
|
||||
let width, height = Sdl.gl_get_drawable_size frame.sdl_win in
|
||||
let _, (_, image) =
|
||||
render
|
||||
{ box=
|
||||
Box2.v (P2.v 0. 0.) (P2.v (float width) (float height))
|
||||
; time= ticks ()
|
||||
; events= !el
|
||||
; wall= frame.wall } in
|
||||
Sdl.gl_make_current frame.sdl_win frame.gl
|
||||
>>= fun () ->
|
||||
let width, height = Sdl.gl_get_drawable_size frame.sdl_win in
|
||||
Gl.viewport 0 0 width height ;
|
||||
Gl.clear_color 0.0 0.0 0.0 1.0 ;
|
||||
Gl.(
|
||||
clear
|
||||
( color_buffer_bit lor depth_buffer_bit
|
||||
lor stencil_buffer_bit )) ;
|
||||
Gl.enable Gl.blend ;
|
||||
Gl.blend_func_separate Gl.one Gl.src_alpha Gl.one
|
||||
Gl.one_minus_src_alpha ;
|
||||
Gl.enable Gl.cull_face_enum ;
|
||||
Gl.disable Gl.depth_test ;
|
||||
let width = float width and height = float height in
|
||||
Wall.Renderer.render frame.wall ~width ~height image ;
|
||||
Sdl.gl_swap_window frame.sdl_win ;
|
||||
Ok () )
|
||||
else Ok ()
|
||||
(get_events ()) in
|
||||
let width, height = Sdl.gl_get_drawable_size frame.sdl_win in
|
||||
if List.length events > 0 then last_pane := actor events ;
|
||||
let _, (_, image) =
|
||||
!last_pane
|
||||
{ box= Box2.v (P2.v 0. 0.) (P2.v (float width) (float height))
|
||||
; time= ticks ()
|
||||
; wall= frame.wall } in
|
||||
Sdl.gl_make_current frame.sdl_win frame.gl
|
||||
>>= fun () ->
|
||||
let width, height = Sdl.gl_get_drawable_size frame.sdl_win in
|
||||
Gl.viewport 0 0 width height ;
|
||||
Gl.clear_color 0.0 0.0 0.0 1.0 ;
|
||||
Gl.(
|
||||
clear
|
||||
(color_buffer_bit lor depth_buffer_bit lor stencil_buffer_bit)) ;
|
||||
Gl.enable Gl.blend ;
|
||||
Gl.blend_func_separate Gl.one Gl.src_alpha Gl.one
|
||||
Gl.one_minus_src_alpha ;
|
||||
Gl.enable Gl.cull_face_enum ;
|
||||
Gl.disable Gl.depth_test ;
|
||||
let width = float width and height = float height in
|
||||
Wall.Renderer.render frame.wall ~width ~height image ;
|
||||
Sdl.gl_swap_window frame.sdl_win ;
|
||||
Ok ()
|
||||
|
||||
let run frame render () =
|
||||
let frame = get_result frame in
|
||||
@ -618,7 +617,9 @@ module Panel = struct
|
||||
type actor = Event.events -> Display.pane
|
||||
|
||||
let blank =
|
||||
{ act= (fun panel _events -> (panel, fun s -> (s, Display.empty)))
|
||||
{ act=
|
||||
(fun panel _events ->
|
||||
(panel, fun s -> (s, Display.image_empty)) )
|
||||
; subpanels= []
|
||||
; tag= "blank pane" }
|
||||
|
||||
@ -1109,10 +1110,7 @@ let () =
|
||||
[ Panel.draw (fun (s : Display.state) ->
|
||||
(s, Display.fill_box (Display.gray 0.125) s.box) )
|
||||
; top_panel top_1 ] ) in
|
||||
Display.(
|
||||
run (make_frame ~title:"hi" ~w:1440 ~h:900 ()) (fun s ->
|
||||
actor s.events s ))
|
||||
()
|
||||
Display.(run (make_frame ~title:"hi" ~w:1440 ~h:900 ()) actor) ()
|
||||
|
||||
(* Implement the "window management" as just toplevel defined functions that manipulate the window tree *)
|
||||
|
||||
|
||||
Reference in New Issue
Block a user