120 lines
3.7 KiB
OCaml
120 lines
3.7 KiB
OCaml
open Tsdl
|
|
|
|
open Wall
|
|
module I = Image
|
|
module P = Path
|
|
module Text = Wall_text
|
|
|
|
let gray ?(a=1.0) v = Color.v v v v a
|
|
|
|
let load_font name =
|
|
let ic = open_in_bin name in
|
|
let dim = in_channel_length ic in
|
|
let fd = Unix.descr_of_in_channel ic in
|
|
let buffer =
|
|
Unix.map_file fd Bigarray.int8_unsigned Bigarray.c_layout false [|dim|]
|
|
|> Bigarray.array1_of_genarray
|
|
in
|
|
let offset = List.hd (Stb_truetype.enum buffer) in
|
|
match Stb_truetype.init buffer offset with
|
|
| None -> assert false
|
|
| Some font -> font
|
|
|
|
let font_icons = lazy (load_font "entypo.ttf")
|
|
let font_sans = lazy (load_font "Roboto-Regular.ttf")
|
|
let font_sans_bold = lazy (load_font "Roboto-Bold.ttf")
|
|
let font_emoji = lazy (load_font "NotoEmoji-Regular.ttf")
|
|
|
|
let w = 1000
|
|
let h = 600
|
|
let f = (try float_of_string Sys.argv.(1) with _ -> 1.0)
|
|
let fw = int_of_float (f *. float w)
|
|
let fh = int_of_float (f *. float h)
|
|
|
|
let draw_label text x y h =
|
|
I.paint (Paint.color (gray ~a:0.5 1.0))
|
|
Text.(simple_text
|
|
(Font.make ~size:18.0 (Lazy.force font_sans))
|
|
~valign:`MIDDLE ~halign:`LEFT
|
|
~x ~y:(y+.h*.0.5) text)
|
|
|
|
let draw_demo mx my w t =
|
|
let node = ref I.empty in
|
|
let push n = node := I.stack !node n in
|
|
let x = 0.0 and y = 0.0 in
|
|
push @@ draw_label "hello world" x y 20.0;
|
|
!node
|
|
|
|
let counter = Performance_counter.make ()
|
|
let dump_perf =
|
|
let t0 = ref 0 in
|
|
fun t ->
|
|
let t = int_of_float t in
|
|
if t <> !t0 then (
|
|
t0 := t;
|
|
prerr_endline (Performance_counter.report counter);
|
|
Performance_counter.reset counter
|
|
)
|
|
|
|
let render context sw sh t =
|
|
let lw = float w in
|
|
let lh = float h in
|
|
let width = lw *. f *. sw in
|
|
let height = lh *. f *. sh in
|
|
let _, (x, y) = Sdl.get_mouse_state () in
|
|
let x = float x /. f and y = float y /. f in
|
|
Renderer.render context ~width ~height ~performance_counter:counter
|
|
(I.seq [
|
|
draw_demo x y lw t;
|
|
]);
|
|
dump_perf t
|
|
|
|
open Tgles2
|
|
|
|
let main () =
|
|
Printexc.record_backtrace true;
|
|
match Sdl.init Sdl.Init.video with
|
|
| Error (`Msg e) -> Sdl.log "Init error: %s" e; exit 1
|
|
| Ok () ->
|
|
ignore (Sdl.gl_set_attribute Sdl.Gl.depth_size 24 : _ result);
|
|
ignore (Sdl.gl_set_attribute Sdl.Gl.stencil_size 8 : _ result);
|
|
match
|
|
Sdl.create_window ~w:fw ~h:fh "SDL OpenGL"
|
|
Sdl.Window.(opengl + allow_highdpi)
|
|
with
|
|
| Error (`Msg e) -> Sdl.log "Create window error: %s" e; exit 1
|
|
| Ok w ->
|
|
ignore (Sdl.gl_set_swap_interval (-1));
|
|
let ow, oh = Sdl.gl_get_drawable_size w in
|
|
Sdl.log "window size: %d,%d\topengl drawable size: %d,%d" fw fh ow oh;
|
|
let sw = float ow /. float fw and sh = float oh /. float fh in
|
|
ignore (Sdl.gl_set_attribute Sdl.Gl.stencil_size 1);
|
|
match Sdl.gl_create_context w with
|
|
| Error (`Msg e) -> Sdl.log "Create context error: %s" e; exit 1
|
|
| Ok ctx ->
|
|
let context = Renderer.create ~antialias:true () in
|
|
let quit = ref false in
|
|
let event = Sdl.Event.create () in
|
|
while not !quit do
|
|
while Sdl.poll_event (Some event) do
|
|
match Sdl.Event.enum (Sdl.Event.get event Sdl.Event.typ) with
|
|
| `Quit -> quit := true
|
|
| _ -> ()
|
|
done;
|
|
Gl.viewport 0 0 ow oh;
|
|
Gl.clear_color 0.3 0.3 0.32 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;
|
|
render context sw sh (Int32.to_float (Sdl.get_ticks ()) /. 1000.0);
|
|
Sdl.gl_swap_window w;
|
|
done;
|
|
Sdl.gl_delete_context ctx;
|
|
Sdl.destroy_window w;
|
|
Sdl.quit ();
|
|
exit 0
|
|
|
|
let () = main ()
|