console/boot
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

still works

Browse Source
This commit is contained in:
cqc
2021-07-13 13:16:59 -05:00
parent dd40228699
commit bff1adc740
1 changed files with 56 additions and 81 deletions
Download Patch File Download Diff File Expand all files Collapse all files

131
bin/main.ml
View File

@ -38,6 +38,7 @@ module Display = struct
open Tgles2
open Tsdl
open Gg
open CamomileLibrary
let (>>=) x f = match x with
| Ok a -> f a
| Error x as result -> result
@ -47,7 +48,8 @@ module Display = struct
| Error (`Msg msg) -> failwith msg
type key = {
uchar:Uchar.t;
char:char;
uchar:CamomileLibrary.UChar.t;
keycode:Sdl.keycode;
scancode:Sdl.scancode;
shift:bool;
@ -62,15 +64,19 @@ module Display = struct
| `Fullscreen of bool
| `None ]
let prev_key = ref {uchar=(Uchar.of_int 0);keycode=0;scancode=0;shift=false;ctrl=false;meta=false;fn=false}
let prev_key = ref {char='\x00'; uchar=(CamomileLibrary.UChar.of_int 0);
keycode=0; scancode=0;
shift=false; ctrl=false; meta=false; fn=false}
open Sdl.K
let event_of_sdlevent ev =
match Sdl.Event.enum (Sdl.Event.get ev Sdl.Event.typ) with
| `Key_down | `Key_up as w ->
let km = Sdl.Event.get ev Sdl.Event.keyboard_keymod in
let kc = Sdl.Event.get ev Sdl.Event.keyboard_keycode in
let uchar = CamomileLibrary.UChar.of_int (if kc land Sdl.K.scancode_mask > 0 then 0 else kc) in
let k = {
uchar=Uchar.of_int (if kc land Sdl.K.scancode_mask > 0 then 0 else kc);
char=(UChar.char_of uchar);
uchar=uchar;
keycode=kc;
scancode=Sdl.Event.get ev Sdl.Event.keyboard_scancode;
shift = (km land Sdl.Kmod.shift)>0;
@ -78,7 +84,7 @@ module Display = struct
meta = (km land Sdl.Kmod.alt)>0;
fn = (km land Sdl.Kmod.gui)>0; } in
(match w with `Key_down -> F.epr "key_down: " | `Key_up -> F.epr "key_up: ");
F.epr "keycode=%x uchar=%C scancode=%x keyname=%s (%s %s %s %s)\n" kc (Uchar.to_char k.uchar) k.scancode
F.epr "keycode=%x uchar=%C scancode=%x keyname=%s (%s %s %s %s)\n" kc (CamomileLibrary.UChar.char_of k.uchar) k.scancode
(Sdl.get_key_name kc)
(if k.shift then " shift" else "")
(if k.ctrl then " ctrl" else "")
@ -91,17 +97,6 @@ module Display = struct
| _ -> `None
let str_of_scancode = Sdl.get_key_name
type keyevent = {
char: Uchar.t;
shift : bool;
ctrl : bool;
meta : bool;
fn : bool;
}
type editbuf = keyevent Zed_edit.t
let key_shift_map =
[('1','!');('2','@');('3','#');('4','$');('5','%');
('6','^');('7','&');('8','*');('9','(');('0',')');
@ -109,31 +104,19 @@ module Display = struct
('\\','|');(';',':');('\'','"');(',','<');('.','>');
('/','?')]
let handle_keyevents (el:event list) (ze:unit Zed_edit.t) (zc:Zed_cursor.t) =
let ctx = Zed_edit.context ze zc in
let res = ref `None in
List.iter (fun ev ->
match ev with
| `Key_up k ->
let c = (Uchar.to_char k.uchar) in
(match c, k with
| _, {keycode=0x40000052}(*up*) -> ignore (Zed_edit.prev_line ctx)
| _, {keycode=0x40000051}(*down*) -> ignore (Zed_edit.next_line ctx)
| _, {keycode=0x40000050}(*left*) -> ignore (Zed_edit.prev_char ctx)
| _, {keycode=0x4000004f}(*right*)-> ignore (Zed_edit.next_char ctx)
| '\r', {ctrl=true; shift=false; meta=false; fn=false} -> res := `Execute
| '\r', {ctrl=false; shift=false; meta=false; fn=false} -> Zed_edit.newline ctx
| '\b', _ -> Zed_edit.remove_prev ctx 1
| '\t', _ -> Zed_edit.insert_char ctx (CamomileLibrary.UChar.of_char '\t')
| _ ->
if k.uchar != (Uchar.of_int 0) then
Zed_edit.insert_char ctx (
match (List.assoc_opt c key_shift_map), k.shift with
| Some k, true -> (CamomileLibrary.UChar.of_char k)
| None, true -> (CamomileLibrary.UChar.of_char (Char.uppercase_ascii c))
| _, false -> (CamomileLibrary.UChar.of_char c)))
| `Key_down a -> ()
| _ -> ()) el; !res
let key_to_uchar k : UChar.t =
match (List.assoc_opt k.char key_shift_map), k with
| _, {char='\x00'} -> (UChar.of_char '\x00')
| Some k, {shift=true} -> (UChar.of_char k)
| None, {shift=true} -> (UChar.of_char (Char.uppercase_ascii k.char))
| _, {shift=false} -> k.uchar
let handle_keyevents (el:event list) f =
List.iter f el
(* current window state to be passed to window renderer *)
type state = { box: box2; (* This is cannonically box within which the next element should draw *)
@ -360,55 +343,36 @@ let draw_pp height fpp (s:Display.state) =
let sp = !sc in
push @@ simple_text f text !sc;
sc := {!sc with box = (Box2.of_pts (P2.v (Box2.maxx !box) (Box2.oy sp.box)) (Box2.max sp.box))};
F.epr "out_string: (\"%s\")\n\tsp.box=%s\n\t!sc.box=%s\n\t!box=%s@."
text (str_of_box sp.box) (str_of_box !sc.box) (str_of_box !box)
in
let out_flush () =
F.epr "out_flush: () %s\n" (str_of_box !sc.box) ; () in
(* F.epr "out_flush: () %s\n" (str_of_box !sc.box) ; *)() in
let out_newline () =
let nlp = P2.v (Box2.ox s.box) ((Box2.oy !sc.box) +. font_height) in
sc := {!sc with box = Box2.of_pts nlp (Box2.max s.box)};
Printf.printf "out_newline: (%0.1f %0.1f) %s\n" (P2.x nlp) (P2.y nlp) (str_of_box !sc.box); flush stdout
sc := {!sc with box = Box2.of_pts (P2.v (Box2.ox s.box) ((Box2.oy !sc.box) +. font_height)) (Box2.max s.box)};
in
let out_spaces n =
let nf = float n in
let wpx = Text.Font.text_width f " " in
let nl = ((Box2.ox !sc.box) +. (nf *. wpx)) > (Box2.maxx !sc.box) in
if nl then begin (* WRAP *)
F.epr "out_spaces: ===== WRAP =======@.";
out_newline ()
end;
if ((Box2.ox !sc.box) +. ((float n) *. wpx)) > (Box2.maxx !sc.box) then (* WRAP *)
begin F.epr "out_spaces: ===== WRAP =======@."; out_newline () end;
let so = !sc in
let bo = Box2.v (Box2.o !sc.box) (P2.v (nf *. wpx) height) in
let ws = (Box2.w !box) /. nf in
for m = 0 to n-1 do
let mf = float m in
let bo = Box2.v (Box2.o !sc.box) (P2.v ((float n) *. wpx) height) in
let bsp = (Box2.v (Box2.br_pt !box) (P2.v wpx height)) in
F.epr "out_space(%d): %s -> %s \n" m (str_of_box !box) (str_of_box bsp);
push @@ pane_hbox [path_circle (Color.v 0.125 1.0 0.125 0.125) bsp] !sc;
done;
push @@ pane_hbox (List.init n (fun n -> path_circle (Color.v 0.125 1.0 0.125 0.125) bsp)) !sc;
box := bo;
sc := {!sc with box = Box2.of_pts (Box2.br_pt bo) (Box2.max so.box)};
Printf.printf "out_spaces: (n=%d=%0.2fpx, nl=%b) %s\n\tbo=%s\n" n (nf *. wpx) nl (str_of_box !sc.box)
(str_of_box bo); flush stdout
in
let out_indent n =
let p = (min ((Box2.w !sc.box)-.1.) (height *. 2.0 *. (float n))) in
sc := {!sc with box = Box2.of_pts
(P2.v ((Box2.ox !sc.box) +. p) (Box2.oy !sc.box))
sc := {!sc with box = Box2.of_pts (P2.v ((Box2.ox !sc.box) +. p) (Box2.oy !sc.box))
(Box2.max !sc.box)};
Printf.printf "out_indent: (n=%d=%0.2fpx) %s\n" n p (str_of_box !sc.box); flush stdout in
in
let pp = Format.formatter_of_out_functions {out_string; out_flush; out_newline; out_spaces; out_indent;} in
Format.pp_set_formatter_stag_functions pp {
mark_open_stag = (fun s ->
(match s with
| Cursor c -> F.epr "mark_open_stag Cursor: %s\n" (str_of_box !sc.box);
push @@ fill_box c (Box2.v (Box2.o !sc.box) (P2.v (height *. 0.333) height)) !sc
| Cursor c -> push @@ fill_box c (Box2.v (Box2.o !sc.box) (P2.v (height *. 0.333) height)) !sc
| Color_bg c -> push @@ fill_box c !box !sc
| _ -> ()); "");
mark_close_stag = (
function
| _ -> ();"");
mark_close_stag = (function | _ -> (); "");
print_open_stag = (fun _ -> (*"<open_stag>"*) ()); (* TKTKTKTK XXX IT SHOULD BE USING THESE print ONES *)
print_close_stag = (fun _ -> (*"<close_stag>"*) ());
};
@ -642,6 +606,21 @@ type textedit = {ze: unit Zed_edit.t; zc: Zed_cursor.t}
let make_textedit () = let z = Zed_edit.create () in {ze = z; zc = Zed_edit.new_cursor z;}
let draw_textedit (te:textedit) height (s:Display.state) =
F.epr "draw_textedit: (Zed_cursor.get_position te.zc)=%d\n" (Zed_cursor.get_position te.zc);
let ctx = Zed_edit.context te.ze te.zc in
List.iter
(function
| `Key_up (k:Display.key) ->
(match k with
| {keycode=0x40000052}(*up*) -> ignore (Zed_edit.prev_line ctx)
| {keycode=0x40000051}(*down*) -> ignore (Zed_edit.next_line ctx)
| {keycode=0x40000050}(*left*) -> ignore (Zed_edit.prev_char ctx)
| {keycode=0x4000004f}(*right*)-> ignore (Zed_edit.next_char ctx)
| {char='\r'; ctrl=false; shift=false; meta=false; fn=false} -> Zed_edit.newline ctx
| {char='\b';} -> Zed_edit.remove_prev ctx 1
| {char='\t'} -> Zed_edit.insert_char ctx (CamomileLibrary.UChar.of_char '\t')
| _ -> Zed_edit.insert_char ctx (Display.key_to_uchar k); ())
| `Key_down _ -> ()
| _ -> ()) s.events;
draw_pp 30. (fun pp ->
let zrb, zra = Zed_rope.break (Zed_edit.text te.ze) (Zed_cursor.get_position te.zc) in
let before_cursor = Zed_string.to_utf8 (Zed_rope.to_string zrb) in
@ -657,23 +636,19 @@ let str_of_textedit (te:textedit) = Zed_string.to_utf8 (Zed_rope.to_string (Zed_
type top_instance = {te: textedit; res: Buffer.t}
let make_top () = {te = (make_textedit ()); res = Buffer.create 1024}
let draw_top (t:top_instance) height (s:Display.state) =
let kr = Display.handle_keyevents s.events t.te.ze t.te.zc in
(match kr with
| `Execute ->
let text = str_of_textedit t.te in
Display.handle_keyevents s.events
(function
| `Key_up {char='\r'; ctrl=true; shift=false; meta=false; fn=false} ->
Buffer.clear t.res;
Topmain.main (Format.formatter_of_buffer t.res) text ();
Topmain.main (Format.formatter_of_buffer t.res) (str_of_textedit t.te) (); ()
| _ -> ());
pane_vbox [
(fun s ->
draw_textedit t.te 30. s);
draw_textedit t.te 30.;
draw_pp 30. (fun pp ->
F.pf pp "%s@." (Buffer.contents t.res);
F.flush pp ()
);
] s
let top_1 = make_top ()
let mouse_state = ref (0,0)