3 Commits

2 changed files with 55 additions and 43 deletions

3
dune
View File

@ -9,6 +9,7 @@
(link_flags (-linkall)) (link_flags (-linkall))
(libraries (libraries
topinf topinf
lwt_ppx
tsdl tsdl
tgls.tgles2 tgls.tgles2
wall wall
@ -27,6 +28,7 @@
(libraries (libraries
fmt fmt
topinf topinf
lwt_ppx
irc-client irc-client
irc-client-lwt irc-client-lwt
irc-client-unix irc-client-unix
@ -39,6 +41,7 @@
(modules boot) (modules boot)
(link_flags (-linkall)) (link_flags (-linkall))
(libraries (libraries
lwt_ppx
lambda-term lambda-term
topinf)) topinf))

83
main.ml
View File

@ -400,7 +400,7 @@ module Display = struct
module P = Path module P = Path
module Text = Wall_text module Text = Wall_text
let ( >>= ) x f = let ( >>>= ) x f =
match x with Ok a -> f a | Error _ as result -> result match x with Ok a -> f a | Error _ as result -> result
let get_result = function let get_result = function
@ -426,6 +426,7 @@ module Display = struct
{ sdl_win: Sdl.window { sdl_win: Sdl.window
; gl: Sdl.gl_context ; gl: Sdl.gl_context
; wall: Wall.renderer ; wall: Wall.renderer
; mutable last_pane: pane
; mutable quit: bool ; mutable quit: bool
; mutable fullscreen: bool } ; mutable fullscreen: bool }
@ -439,67 +440,55 @@ module Display = struct
let make_frame ?(title = "komm") ~w ~h () = let make_frame ?(title = "komm") ~w ~h () =
Lazy.force video_initialized Lazy.force video_initialized
>>= fun () -> >>>= fun () ->
Sdl.create_window ~w ~h title Sdl.create_window ~w ~h title
Sdl.Window.( Sdl.Window.(
opengl + allow_highdpi + resizable (*+ input_grabbed*)) opengl + allow_highdpi + resizable (*+ input_grabbed*))
>>= fun sdl_win -> >>>= fun sdl_win ->
Sdl.set_window_title sdl_win title ; Sdl.set_window_title sdl_win title ;
ignore (Sdl.gl_set_swap_interval (-1)) ; ignore (Sdl.gl_set_swap_interval (-1)) ;
ignore (Sdl.gl_set_attribute Sdl.Gl.stencil_size 1) ; ignore (Sdl.gl_set_attribute Sdl.Gl.stencil_size 1) ;
on_failure on_failure
( Sdl.gl_create_context sdl_win ( Sdl.gl_create_context sdl_win
>>= fun gl -> >>>= fun gl ->
let wall = let wall =
Wall.Renderer.create ~antialias:true ~stencil_strokes:true () Wall.Renderer.create ~antialias:true ~stencil_strokes:true ()
in in
Ok {sdl_win; gl; wall; quit= false; fullscreen= false} ) Ok
{ sdl_win
; gl
; wall
; quit= false
; fullscreen= false
; last_pane= pane_empty } )
~cleanup:(fun () -> Sdl.destroy_window sdl_win) ~cleanup:(fun () -> Sdl.destroy_window sdl_win)
let get_events () = let handle_frame_events frame events =
(* create and fill event list *) List.iter
let ev = Sdl.Event.create () in (fun (e : Event.t) ->
let el = ref [`None] in match e with
while Sdl.wait_event_timeout (Some ev) 50 (* HACK *) do | `Quit -> frame.quit <- true
let e = Event.event_of_sdlevent ev in
if e != `None then el := !el @ [e]
(* HACK? *)
done ;
!el
let last_pane = ref pane_empty
let display_frame frame actor =
let events =
(* Handle relevant events *)
List.filter_map
(function
| `Quit ->
frame.quit <- true ;
None
| `Fullscreen a -> | `Fullscreen a ->
if a then ( frame.fullscreen <- a ;
frame.fullscreen <- not frame.fullscreen ; ignore (Sdl.show_cursor (not frame.fullscreen) : _ result) ;
ignore
(Sdl.show_cursor (not frame.fullscreen) : _ result) ;
ignore ignore
( Sdl.set_window_fullscreen frame.sdl_win ( Sdl.set_window_fullscreen frame.sdl_win
( if frame.fullscreen then ( if frame.fullscreen then
Sdl.Window.fullscreen_desktop Sdl.Window.fullscreen_desktop
else Sdl.Window.windowed ) else Sdl.Window.windowed )
: _ result ) ) ; : _ result )
None | _ -> () )
| a -> Some a ) events
(get_events ()) in
let draw_pane frame pane =
let width, height = Sdl.gl_get_drawable_size frame.sdl_win 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) = let _, (_, image) =
!last_pane pane
{ box= Box2.v (P2.v 0. 0.) (P2.v (float width) (float height)) { box= Box2.v (P2.v 0. 0.) (P2.v (float width) (float height))
; time= ticks () ; time= ticks ()
; wall= frame.wall } in ; wall= frame.wall } in
Sdl.gl_make_current frame.sdl_win frame.gl Sdl.gl_make_current frame.sdl_win frame.gl
>>= fun () -> >>>= fun () ->
let width, height = Sdl.gl_get_drawable_size frame.sdl_win in let width, height = Sdl.gl_get_drawable_size frame.sdl_win in
Gl.viewport 0 0 width height ; Gl.viewport 0 0 width height ;
Gl.clear_color 0.0 0.0 0.0 1.0 ; Gl.clear_color 0.0 0.0 0.0 1.0 ;
@ -516,6 +505,26 @@ module Display = struct
Sdl.gl_swap_window frame.sdl_win ; Sdl.gl_swap_window frame.sdl_win ;
Ok () Ok ()
let display_frame frame actor =
(* create and fill event list *)
let convert_event ev =
match Event.event_of_sdlevent ev with
(* Handle relevant events *)
| a -> a in
let ev = Sdl.Event.create () in
let events : Event.t list ref = ref [] in
if Sdl.wait_event_timeout (Some ev) 100 then (
events := !events @ [convert_event ev] ;
while Sdl.wait_event_timeout (Some ev) 1 do
events := !events @ [convert_event ev]
done ) ;
handle_frame_events frame !events ;
if List.length !events > 0 then
(* recompute the actor definition with the new events to return a new pane *)
frame.last_pane <- actor !events ;
(* call draw_pane because we should redraw now that we have updated *)
draw_pane frame frame.last_pane
let run frame render () = let run frame render () =
let frame = get_result frame in let frame = get_result frame in
Sdl.show_window frame.sdl_win ; Sdl.show_window frame.sdl_win ;