Compare commits
3 Commits
fe935c4e1f
...
c8e9e1bd6c
| Author | SHA1 | Date | |
|---|---|---|---|
| c8e9e1bd6c | |||
| cf01415754 | |||
| eca8a055cf |
5
dune
5
dune
@ -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))
|
||||||
|
|
||||||
@ -47,7 +50,7 @@
|
|||||||
(modes byte)
|
(modes byte)
|
||||||
(modules topinf)
|
(modules topinf)
|
||||||
(libraries
|
(libraries
|
||||||
fmt
|
fmt
|
||||||
tsdl
|
tsdl
|
||||||
tgls.tgles2
|
tgls.tgles2
|
||||||
wall
|
wall
|
||||||
|
|||||||
93
main.ml
93
main.ml
@ -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
|
| `Fullscreen a ->
|
||||||
if e != `None then el := !el @ [e]
|
frame.fullscreen <- a ;
|
||||||
(* HACK? *)
|
ignore (Sdl.show_cursor (not frame.fullscreen) : _ result) ;
|
||||||
done ;
|
ignore
|
||||||
!el
|
( Sdl.set_window_fullscreen frame.sdl_win
|
||||||
|
( if frame.fullscreen then
|
||||||
|
Sdl.Window.fullscreen_desktop
|
||||||
|
else Sdl.Window.windowed )
|
||||||
|
: _ result )
|
||||||
|
| _ -> () )
|
||||||
|
events
|
||||||
|
|
||||||
let last_pane = ref pane_empty
|
let draw_pane frame pane =
|
||||||
|
|
||||||
let display_frame frame actor =
|
|
||||||
let events =
|
|
||||||
(* Handle relevant events *)
|
|
||||||
List.filter_map
|
|
||||||
(function
|
|
||||||
| `Quit ->
|
|
||||||
frame.quit <- true ;
|
|
||||||
None
|
|
||||||
| `Fullscreen a ->
|
|
||||||
if a then (
|
|
||||||
frame.fullscreen <- not frame.fullscreen ;
|
|
||||||
ignore
|
|
||||||
(Sdl.show_cursor (not frame.fullscreen) : _ result) ;
|
|
||||||
ignore
|
|
||||||
( Sdl.set_window_fullscreen frame.sdl_win
|
|
||||||
( if frame.fullscreen then
|
|
||||||
Sdl.Window.fullscreen_desktop
|
|
||||||
else Sdl.Window.windowed )
|
|
||||||
: _ result ) ) ;
|
|
||||||
None
|
|
||||||
| a -> Some a )
|
|
||||||
(get_events ()) in
|
|
||||||
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 ;
|
||||||
|
|||||||
Reference in New Issue
Block a user