zapashcanon/sun
1
0
Fork 0
Code Issues 1 Pull Requests Actions Releases Wiki Activity

remove useless stuff, clean code

Browse Source
This commit is contained in:
zapashcanon 2022-01-30 22:19:07 +01:00
parent 23816dba39
commit 9b165dc925
Signed by: zapashcanon
GPG Key ID: 8981C3C62D1D28F1
3 changed files with 14 additions and 121 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/dune
View File

@ -1,9 +1,4 @@
(executable
(name sun)
(modules sun)
(libraries directories unix))
(executable
(name sun_gui)
(modules sun_gui)
(libraries directories tsdl tsdl_ttf unix))
(libraries directories scfg unix))

25
src/sun.ml
View File

@ -1,10 +1,12 @@
(* module App_id = struct
module Project_dirs = Directories.Project_dirs (struct
let qualifier = "fr"
let organization = "zapashcanon"
let application = "sun"
end
module Project_dirs = Directories.Project_dirs (App_id)*)
let organization = "zapashcanon"
let application = "sun"
end)
module User_dirs = Directories.User_dirs ()
let error msg =
Format.eprintf "error: %s@." msg;
@ -26,21 +28,20 @@ let grim region output_file =
| WEXITED 0 -> ()
| _err -> error "grim failed"
let check_usage () =
if Array.length Sys.argv > 2 then
error (Format.sprintf "usage: %s [FILE]@." Sys.argv.(0))
let output_file () =
if Array.length Sys.argv = 2 then Sys.argv.(1)
else
let module User_dirs = Directories.User_dirs () in
let dir = Option.value User_dirs.picture_dir ~default:(Unix.getcwd ()) in
let t = Unix.localtime @@ Unix.gettimeofday () in
let file_name = Format.sprintf "%d%02d%02d_%02dh%02dm%02ds_sun.png" (1900 + t.tm_year) (1 + t.tm_mon) t.tm_mday t.tm_hour t.tm_min t.tm_sec in
let file_name =
Format.sprintf "%d%02d%02d_%02dh%02dm%02ds_sun.png" (1900 + t.tm_year)
(1 + t.tm_mon) t.tm_mday t.tm_hour t.tm_min t.tm_sec
in
Filename.concat dir file_name
let () =
check_usage ();
if Array.length Sys.argv > 2 then
error (Format.sprintf "usage: %s [FILE]@." Sys.argv.(0));
let region = slurp () in
let output_file = output_file () in
grim region output_file

103
src/sun_gui.ml
View File

@ -1,103 +0,0 @@
(* module App_id = struct
let qualifier = "fr"
let organization = "zapashcanon"
let application = "sun"
end
module Project_dirs = Directories.Project_dirs (App_id)*)
let error msg =
Format.eprintf "error: %s@." msg;
exit 1
let slurp () =
let chan = Unix.open_process_in "slurp" in
try
let output = input_line chan in
match Unix.close_process_in chan with
| WEXITED 0 -> output
| _err -> error "slurp failed"
with End_of_file -> error "slurp failed"
let grim region output_file =
let cmd = Format.sprintf {|grim -g "%s" "%s"|} region output_file in
let chan = Unix.open_process_in cmd in
match Unix.close_process_in chan with
| WEXITED 0 -> ()
| _err -> error "grim failed"
let check_usage () =
if Array.length Sys.argv > 2 then
error (Format.sprintf "usage: %s [FILE]@." Sys.argv.(0))
let output_file () =
if Array.length Sys.argv = 2 then Sys.argv.(1)
else
let module User_dirs = Directories.User_dirs () in
let dir = Option.value User_dirs.picture_dir ~default:(Unix.getcwd ()) in
let t = Unix.localtime @@ Unix.gettimeofday () in
let file_name = Format.sprintf "%d%02d%02d_%02dh%02dm%02ds_sun.png" (1900 + t.tm_year) (1 + t.tm_mon) t.tm_mday t.tm_hour t.tm_min t.tm_sec in
Filename.concat dir file_name
(*
let () =
check_usage ();
let region = slurp () in
let output_file = output_file () in
grim region output_file
*)
let rec loop =
let open Tsdl.Sdl in
ignore @@ init Init.everything;
let w =
let open Window in
match create_window "sun" ~x:0 ~y:0 ~w:0 ~h:0 (shown + resizable + maximized) with
| Ok w -> w
| Error (`Msg msg) -> error (Format.sprintf "can't create window: %s" msg)
in
let rend =
let open Renderer in
match create_renderer ~index:(-1) ~flags:(presentvsync) w with
| Ok rend -> rend
| Error (`Msg msg) -> error (Format.sprintf "can't create renderer: %s" msg)
in
let present () = render_present rend in
let clear () =
match render_fill_rect rend None with
| Ok () -> ()
| Error (`Msg msg) -> error (Format.sprintf "can't clear renderer: %s" msg)
in
clear ();
let e = Event.create () in
let fg_color = Color.create ~r:200 ~g:200 ~b:127 ~a:255 in
ignore @@ Tsdl_ttf.Ttf.init ();
let font = match Tsdl_ttf.Ttf.open_font "/usr/share/fonts/truetype/robotomono/Roboto Mono Nerd Font Complete Mono.ttf" 36 with
| Error (`Msg msg) -> error (Format.sprintf "can't open font: %s" msg)
| Ok font -> font
in
let surface = match Tsdl_ttf.Ttf.render_text_solid font "hello" fg_color with
| Error (`Msg msg) -> error (Format.sprintf "can't render text solid: %s" msg)
| Ok surface -> surface
in
let texture = match create_texture_from_surface rend surface with
| Error (`Msg msg) -> error (Format.sprintf "can't create texture from surface: %s" msg)
| Ok texture -> texture
in
fun () ->
begin match render_copy rend texture with
| Ok () -> ()
| Error (`Msg msg) -> error (Format.sprintf "can't create texture from surface: %s" msg)
end;
present ();
clear ();
match wait_event (Some e) with
| Error (`Msg msg) -> error (Format.sprintf "can't wait event: %s" msg)
| Ok () ->
match Event.(enum (get e typ)) with
| `Quit -> ()
| `Key_down when (Event.get e Event.keyboard_keycode = K.escape)-> ()
| _e -> loop ()
let () = loop ()