actually seperate act from render

This commit is contained in:
cqc
2021-09-01 05:05:48 -05:00
parent 3004a87571
commit d6b16f2a4e

86
main.ml
View File

@ -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 *)