WIP layout engine

This commit is contained in:
Nathan Anderson 2024-10-10 12:54:53 -06:00
commit 13c8a36ba7
17 changed files with 685 additions and 0 deletions

3
.gitignore vendored Normal file
View File

@ -0,0 +1,3 @@
_build/**
.direnv/**
.envrc

2
.ocamlformat Normal file
View File

@ -0,0 +1,2 @@
version=0.26.2
profile=default

4
bin/dune Normal file
View File

@ -0,0 +1,4 @@
(executable
(public_name tuiano)
(name main)
(libraries tuiano))

5
bin/main.ml Normal file
View File

@ -0,0 +1,5 @@
let () =
Tuiano.Tui.setup_terminal();
(* let term = Tuiano.Tui.termsize in *)
(* match term with *)
(* | (h, w) -> Printf.printf "Got tty size: %d x %d\n" h w *)

26
dune-project Normal file
View File

@ -0,0 +1,26 @@
(lang dune 3.16)
(name tuiano)
(generate_opam_files true)
(source
(github username/reponame))
(authors "Nate Anderson")
(maintainers "Nate Anderson")
(license LICENSE)
(documentation https://fosscat.com)
(package
(name tuiano)
(synopsis "A Piano keyboard on the TUI")
(description "A Piano keyboard on the TUI")
(depends ocaml dune)
(tags
(topics "to describe" your project)))
; See the complete stanza docs at https://dune.readthedocs.io/en/stable/reference/dune-project/index.html

61
flake.lock generated Normal file
View File

@ -0,0 +1,61 @@
{
"nodes": {
"flake-utils": {
"inputs": {
"systems": "systems"
},
"locked": {
"lastModified": 1726560853,
"narHash": "sha256-X6rJYSESBVr3hBoH0WbKE5KvhPU5bloyZ2L4K60/fPQ=",
"owner": "numtide",
"repo": "flake-utils",
"rev": "c1dfcf08411b08f6b8615f7d8971a2bfa81d5e8a",
"type": "github"
},
"original": {
"owner": "numtide",
"repo": "flake-utils",
"type": "github"
}
},
"nixpkgs": {
"locked": {
"lastModified": 1727634051,
"narHash": "sha256-S5kVU7U82LfpEukbn/ihcyNt2+EvG7Z5unsKW9H/yFA=",
"owner": "nixos",
"repo": "nixpkgs",
"rev": "06cf0e1da4208d3766d898b7fdab6513366d45b9",
"type": "github"
},
"original": {
"owner": "nixos",
"ref": "nixos-unstable",
"repo": "nixpkgs",
"type": "github"
}
},
"root": {
"inputs": {
"flake-utils": "flake-utils",
"nixpkgs": "nixpkgs"
}
},
"systems": {
"locked": {
"lastModified": 1681028828,
"narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
"owner": "nix-systems",
"repo": "default",
"rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
"type": "github"
},
"original": {
"owner": "nix-systems",
"repo": "default",
"type": "github"
}
}
},
"root": "root",
"version": 7
}

36
flake.nix Normal file
View File

@ -0,0 +1,36 @@
{
description = "A very basic flake";
inputs = {
nixpkgs.url = "github:nixos/nixpkgs?ref=nixos-unstable";
flake-utils.url = "github:numtide/flake-utils";
};
outputs = { self, flake-utils, nixpkgs }:
flake-utils.lib.eachDefaultSystem (system: let
pkgs = import nixpkgs {
inherit system;
};
in {
devShell =
#let
#
#in
pkgs.mkShell {
buildInputs = with pkgs; [
ocaml
ocamlPackages.ocaml-lsp
ocamlPackages.findlib
ocamlformat
ocamlPackages.ocamlformat-rpc-lib
ocamlPackages.utop
dune_3
opam
# Project deps
ocamlPackages.ppxlib
ocamlPackages.ppx_deriving
];
};
});
}

183
lib/ansi.ml Normal file
View File

@ -0,0 +1,183 @@
open Unix
(* type coords = int * int *)
type offset = { x : int; y : int }
type ansirgb = int * int * int
type cursor_ops = Hide | Show | Move of offset
type screen_ops = Clear
type color =
| Black
| Red
| Green
| Yellow
| Blue
| Magenta
| Cyan
| White
| Gray
| BrightRed
| BrightGreen
| BrightYellow
| BrightBlue
| BrightMagenta
| BrightCyan
| BrightWhite
| Default
| Custom of ansirgb
type color_style =
| Foreground of color
| Background of color
type style =
| Reset
| Bold
| Underlined
| Blink
| Inverse
| Hidden
type ansi =
| Cursor of cursor_ops
| Screen of screen_ops
| ColorStyle of color_style
| Style of style
let top_block = ""
let bot_block = ""
let block = ""
let black = Foreground Black
let red = Foreground Red
let green = Foreground Green
let yellow = Foreground Yellow
let blue = Foreground Blue
let magenta = Foreground Magenta
let cyan = Foreground Cyan
let white = Foreground White
let default = Foreground Default
let bg_black = Background Black
let bg_red = Background Red
let bg_green = Background Green
let bg_yellow = Background Yellow
let bg_blue = Background Blue
let bg_magenta = Background Magenta
let bg_cyan = Background Cyan
let bg_white = Background White
let bg_default = Background Default
let is_valid_rgb = function x when x > 5 || x < 0 -> false | _ -> true
let rgb_to_ansi (rgb : ansirgb) =
let rr, gg, bb = rgb in
if is_valid_rgb rr && is_valid_rgb gg && is_valid_rgb bb then
Ok (16 + (36 * rr) + (6 * gg) + bb)
else Error "Invalid r, g, or b value provided (must be between 0-5)"
let screenop_to_ansi = function Clear -> "\027[2J"
let cursorop_to_ansi = function
| Show -> "\027[?25h"
| Hide -> "\027[?25l"
| Move coord -> Printf.sprintf "\027[%d;%dH" coord.y coord.x
(* Function to get the ANSI escape code for a color *)
let color_to_ansi = function
| Black -> "\027[30m"
| Red -> "\027[31m"
| Green -> "\027[32m"
| Yellow -> "\027[33m"
| Blue -> "\027[34m"
| Magenta -> "\027[35m"
| Cyan -> "\027[36m"
| White -> "\027[37m"
| Gray -> "\027[90m"
| BrightRed -> "\027[91m"
| BrightGreen -> "\027[92m"
| BrightYellow -> "\027[9m"
| BrightBlue -> "\027[94m"
| BrightMagenta -> "\027[95m"
| BrightCyan -> "\027[96m"
| BrightWhite -> "\027[97m"
| Default -> "\027[39m" (* Reset to default foreground color *)
| Custom rgb -> (
let ansi = rgb_to_ansi rgb in
match ansi with Ok s -> Printf.sprintf "\027[38m;5;%d" s | Error _ -> "")
let bgcolor_to_ansi = function
| Black -> "\027[40m"
| Red -> "\027[41m"
| Green -> "\027[42m"
| Yellow -> "\027[4m"
| Blue -> "\027[44m"
| Magenta -> "\027[45m"
| Cyan -> "\027[46m"
| White -> "\027[47m"
| Gray -> "\027[100m"
| BrightRed -> "\027[101m"
| BrightGreen -> "\027[102m"
| BrightYellow -> "\027[10m"
| BrightBlue -> "\027[10m"
| BrightMagenta -> "\027[105m"
| BrightCyan -> "\027[106m"
| BrightWhite -> "\027[107m"
| Default -> "\027[49m" (* Reset to default background color *)
| Custom rgb -> (
let ansi = rgb_to_ansi rgb in
match ansi with Ok s -> Printf.sprintf "\027[48m;5;%d" s | Error _ -> "")
(* Function to get the ANSI escape code for a style *)
let style_to_ansi = function
| Reset -> "\027[0m"
| Bold -> "\027[1m"
| Underlined -> "\027[4m"
| Blink -> "\027[5m"
| Inverse -> "\027[7m"
| Hidden -> "\027[8m"
let color_style_to_ansi = function
| Foreground color -> color_to_ansi color
| Background color -> bgcolor_to_ansi color
(* You would define background colors as well *)
let string_of_ansi = function
| ColorStyle op -> color_style_to_ansi op
| Cursor op -> cursorop_to_ansi op
| Style op -> style_to_ansi op
| Screen op -> screenop_to_ansi op
(* let cus_for = color_to_ansi Foreground Custom (3; 4; 1)) *)
let pixel_ansi offset color_style =
let color_ansi = color_style_to_ansi color_style in
let move_ansi = cursorop_to_ansi (Move offset) in
let ansi = Printf.sprintf "%s%s%s" move_ansi color_ansi block in
ansi
(* Gets the terminal height and width from running `stty size` *)
let termsize: offset =
let command = "stty size" in
let in_channel = open_process_in command in
try
let line = input_line in_channel in
close_in in_channel;
let parts = String.split_on_char ' ' line in
match parts with
| [height; width] ->
{x = (int_of_string width); y = (int_of_string height)}
| _ ->
let msg = Printf.sprintf "Unexpected output from stty size: %s" line in
failwith msg
with
| End_of_file ->
close_in in_channel;
failwith "No output from `stty size`"
| Sys_error msg ->
close_in in_channel;
Printf.eprintf "Error reading input: %s\n" msg;
failwith "Failed to get terminal size"
| Failure msg ->
Printf.eprintf "Error converting size to int: %s\n" msg;
failwith "Failed to parse terminal size"

70
lib/ansi.mli Normal file
View File

@ -0,0 +1,70 @@
type offset = { x : int; y : int }
type ansirgb = int * int * int
type cursor_ops = Hide | Show | Move of offset
type screen_ops = Clear
type color =
| Black
| Red
| Green
| Yellow
| Blue
| Magenta
| Cyan
| White
| Gray
| BrightRed
| BrightGreen
| BrightYellow
| BrightBlue
| BrightMagenta
| BrightCyan
| BrightWhite
| Default
| Custom of ansirgb
type color_style =
| Foreground of color
| Background of color
type style =
| Reset
| Bold
| Underlined
| Blink
| Inverse
| Hidden
type ansi =
| Cursor of cursor_ops
| Screen of screen_ops
| ColorStyle of color_style
| Style of style
val string_of_ansi: ansi -> string
val termsize: offset
val pixel_ansi: offset -> color_style -> string
val top_block: string
val bot_block: string
val block: string
val black: color_style
val red: color_style
val green: color_style
val yellow: color_style
val blue: color_style
val magenta: color_style
val cyan: color_style
val white: color_style
val default: color_style
val bg_black: color_style
val bg_red: color_style
val bg_green: color_style
val bg_yellow: color_style
val bg_blue: color_style
val bg_magenta: color_style
val bg_cyan: color_style
val bg_white: color_style
val bg_default: color_style

4
lib/dune Normal file
View File

@ -0,0 +1,4 @@
(library
(name tuiano)
(libraries unix)
(preprocess (pps ppx_deriving.show)))

7
lib/ex.ml Normal file
View File

@ -0,0 +1,7 @@
let greet name =
let message = "Greetings, " ^ name in
print_endline message
let v = String.split_on_char ' ' "Hello using ppx heyo!!"
let string_of_string_list = [% show: string list]

3
lib/ex.mli Normal file
View File

@ -0,0 +1,3 @@
val greet: string -> unit
val string_of_string_list : string list -> string
val v: string list

64
lib/tui.ml Normal file
View File

@ -0,0 +1,64 @@
open Unix
open Ansi
open Widgets
let write_out line =
ignore (write stdout (String.to_bytes line) 0 (String.length line))
let set_raw_mode fd =
let original_attrs = tcgetattr fd in
let raw_attrs = original_attrs in
raw_attrs.c_ignbrk <- false; (* Do not ignore break conditions *)
raw_attrs.c_icanon <- false; (* Disable canonical mode *)
raw_attrs.c_echo <- false; (* Disable echo mode *)
tcsetattr fd TCSAFLUSH raw_attrs;
(* Hide cursor *)
write_out "\027[?25l";
original_attrs (* Return original attributes *)
let restore_terminal fd original_attrs =
(* Show cursor *)
write_out "\027[?25h";
tcsetattr fd TCSADRAIN original_attrs
let setup_terminal () =
let fd = stdin in
let original_attrs = set_raw_mode fd in
let off: offset = {x = 1000; y = 1000;} in
let color = red in
let {x = term_x; y = term_y} = termsize in
(* let out_channel = out_channel_of_descr stdout in *)
write_out "Raw mode enabled.\n";
(* flush out_channel; *)
sleepf 0.5;
let cursor = Cursor (Move {x = term_x; y = term_y}) |> string_of_ansi in
(* Printf.sprintf "\027[%d;%dH" (term_y - 10) (termsize.x - 10) in *)
(* clear screen cursor to pos text *)
let line = "\027[2J" ^ cursor ^ "Test 123\n" in
let screen = Column(
default_column_opts,
[
Text "Testing 123";
Row(
default_row_opts,
[
Padding(
default_padding_opts,
Text "Padded child"
)
]
)
])
|> string_of_widget in
write_out line;
(* flush out_channel; *)
sleep 1;
write_out screen;
sleep 1;
write_out "test this one\n";
sleep 1;
write_out (pixel_ansi off color);
write_out "and another";
sleep 1;
restore_terminal fd original_attrs

184
lib/widgets.ml Normal file
View File

@ -0,0 +1,184 @@
open Ansi
type bounded_constraints = {
max_width: int option;
min_width: int option;
max_height: int option;
min_height: int option;
}
type constraints =
| Unbounded
| Bounded of bounded_constraints
type size = {
height: int;
width: int
}
type alignment =
| Start
| Center
| End
| Stretch
| Even
type cross_alignment =
| Start
| Center
| End
| Stretch
| Even
type box_options = {
alignment: alignment;
cross_alignment: cross_alignment;
}
type padding_options = {
left: int;
right: int;
bottom: int;
top: int;
}
type widget_options =
| Box of box_options
| Padding of padding_options
let default_padding_opts = {
left = 0;
right = 0;
bottom = 0;
top = 0;
}
let default_column_opts = {
alignment = Start;
cross_alignment = Center;
}
let default_row_opts = {
alignment = Start;
cross_alignment = Center;
}
type ansi_widget =
| Column of box_options * ansi_widget list
| Row of box_options * ansi_widget list
| Text of string
| Padding of padding_options * ansi_widget
type widget_element =
| ElementColumn of constraints * size ref * box_options * widget_element list
| ElementRow of constraints * size ref * box_options * widget_element list
| ElementText of constraints * size ref * string
| ElementPadding of constraints * size ref * padding_options * widget_element
let size_of_widget_element = function
| ElementColumn (_, s, _, _) -> !s
| ElementRow (_, s, _, _) -> !s
| ElementText (_, s, _) -> !s
| ElementPadding (_, s, _, _) -> !s
(* let descend_widget_tree_list widget_list = *)
(* let widgets = List.iter descend_widget_tree widge_list in *)
(* List.fold_left (^) widgets *)
let rec make_spacer = function
| 0 -> ""
| n -> " " ^ make_spacer (n - 1)
let rec descend_widget_tree depth widget_tree =
match widget_tree with
| Column (c_opts, widgets) ->
let _ = c_opts in
let deeper = depth + 1 in
let widget_strings = List.map (descend_widget_tree deeper) widgets in
let line = String.concat "" widget_strings in
let spacer = make_spacer depth in
spacer ^ "Column ->\n" ^ line
| Row (r_opts, widgets) ->
let _ = r_opts in
let deeper = depth + 1 in
let widget_strings = List.map (descend_widget_tree deeper) widgets in
let line = String.concat "" widget_strings in
let spacer = make_spacer depth in
spacer ^ "Row ->\n" ^ line
| Text s ->
let spacer = make_spacer depth in
spacer ^ Printf.sprintf "Text: \"%s\"\n" s
| Padding (_, widget) ->
let spacer = make_spacer depth in
spacer ^ "Padding ->\n" ^ descend_widget_tree (depth + 1) widget
let debug_string_of_widget ansi_widget =
(* let {x = term_x; y = term_y} = termsize in *)
descend_widget_tree 0 ansi_widget
let max_constraints =
let {x = term_x; y = term_y} = termsize in
Bounded {max_width = Some term_x; max_height = Some term_y; min_height = Some 0; min_width = Some 0}
(**
1. Layout - Descend tree, parent passing down constraints, child passing up size
2. Convert ansi_widget tree to widget_element tree
**)
let layout_tree ansi_widget =
let filter_sizes elements = List.map size_of_widget_element elements in
let sum_sizes_col = (fun {height = h; width = w} element ->
{height = h + element.height; width = max w element.width}
) in
let sum_sizes_row = (fun {height = h; width = w} element ->
{height = max h element.height; width = w + element.width}
) in
let subtract_bound some_x x =
match some_x with
| Some i -> Some (max (x - i) 0)
| None -> Some x
in
let rec layout_tree_list constraints widgets =
let constrained_layout = layout_tree_rec constraints in
let elements = List.map constrained_layout widgets in
elements
and layout_tree_rec constraints widget_tree =
let size = ref {height = 0; width = 0} in
match widget_tree with
| Column (c_opts, widgets) ->
let widget_elements = (layout_tree_list constraints widgets) in
let sizes = filter_sizes widget_elements in
size := List.fold_left sum_sizes_col {height = 0; width = 0} sizes;
ElementColumn( constraints, size, c_opts, widget_elements)
| Row (r_opts, widgets) ->
let widget_elements = (layout_tree_list constraints widgets) in
let sizes = filter_sizes widget_elements in
size := List.fold_left sum_sizes_row {height = 0; width = 0} sizes;
ElementRow( constraints, size, r_opts, widget_elements)
| Text (s) ->
size := {height = 1; width = String.length s};
ElementText (constraints, size, s)
| Padding (p_opts, widget) ->
let vertical_padding = p_opts.top + p_opts.bottom in
let horizontal_padding = p_opts.left + p_opts.right in
let new_constraints = match constraints with
| Bounded cons -> Bounded {
max_height = (subtract_bound cons.max_height vertical_padding);
max_width = (subtract_bound cons.max_width horizontal_padding);
min_height = Some vertical_padding;
min_width = Some horizontal_padding; }
| Unbounded -> Bounded {
max_height = None;
max_width = None;
min_height = Some vertical_padding;
min_width = Some horizontal_padding;
}
in
let element = layout_tree_rec new_constraints widget in
let element_size = size_of_widget_element element in
size := {width = horizontal_padding + element_size.width; height = vertical_padding + element_size.width};
ElementPadding (constraints, size, p_opts, element)
in
let size = ref {height = 0; width = 0} in
layout_tree_rec max_constraints ansi_widget

2
test/dune Normal file
View File

@ -0,0 +1,2 @@
(test
(name test_tuiano))

0
test/test_tuiano.ml Normal file
View File

31
tuiano.opam Normal file
View File

@ -0,0 +1,31 @@
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
synopsis: "A Piano keyboard on the TUI"
description: "A Piano keyboard on the TUI"
maintainer: ["Nate Anderson"]
authors: ["Nate Anderson"]
license: "LICENSE"
tags: ["topics" "to describe" "your" "project"]
homepage: "https://github.com/username/reponame"
doc: "https://fosscat.com"
bug-reports: "https://github.com/username/reponame/issues"
depends: [
"ocaml"
"dune" {>= "3.16"}
"odoc" {with-doc}
]
build: [
["dune" "subst"] {dev}
[
"dune"
"build"
"-p"
name
"-j"
jobs
"@install"
"@runtest" {with-test}
"@doc" {with-doc}
]
]
dev-repo: "git+https://github.com/username/reponame.git"