package hardcaml_waveterm
A terminal based digital waveform viewer for Hardcaml
Install
Dune Dependency
Authors
Maintainers
Sources
hardcaml_waveterm-v0.16.0.tar.gz
sha256=20844546139ee69e8d328b75a54369b2c1db91d88e43f7ca9ccfc0cd855be828
doc/src/hardcaml_waveterm.kernel/write.ml.html
Source file write.ml
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190
open Base type styler = { start : (string -> unit) -> unit ; set : (string -> unit) -> Draw.Style.t -> unit ; eol : (string -> unit) -> unit ; finish : (string -> unit) -> unit } let no_styler = { start = (fun _ -> ()) ; set = (fun _ _ -> ()) ; eol = (fun _ -> ()) ; finish = (fun _ -> ()) } ;; open Draw.Style let str_of_colour = function | Black -> "black" | Red -> "red" | Green -> "green" | Yellow -> "yellow" | Blue -> "blue" | Magenta -> "magenta" | Cyan -> "cyan" | White -> "white" ;; let int_of_colour = function | Black -> 0 | Red -> 1 | Green -> 2 | Yellow -> 3 | Blue -> 4 | Magenta -> 5 | Cyan -> 6 | White -> 7 ;; let html_styler = let prev = ref default in let set_style style os = os (Printf.sprintf "<span style=\"background-color:%s; color:%s; font-weight:%s\">" (str_of_colour style.bg) (str_of_colour style.fg) (if style.bold then "bold" else "normal")) in let close_style os = os "</span>" in { start = (fun os -> prev := default; set_style default os) ; set = (fun os style -> if Draw.Style.compare style !prev <> 0 then ( prev := style; close_style os; set_style style os)) ; eol = (fun _ -> ()) ; finish = close_style } ;; let css_class_styler = let prev = ref default in let set_style style os = os (Printf.sprintf "<span class=\"w%i%i%s\">" (int_of_colour style.bg) (int_of_colour style.fg) (if style.bold then "b" else "")) in let close_style os = os "</span>" in { start = (fun os -> prev := default; set_style default os) ; set = (fun os style -> if Draw.Style.compare style !prev <> 0 then ( prev := style; close_style os; set_style style os)) ; eol = (fun _ -> ()) ; finish = close_style } ;; let css_classes = let css fg bg b = Printf.sprintf ".w%i%i%s { background-color:%s; color:%s; font-weight:%s; }" (int_of_colour bg) (int_of_colour fg) (if b then "b" else "") (str_of_colour bg) (str_of_colour fg) (if b then "bold" else "normal") in let colours = [ Black; Red; Green; Yellow; Blue; Magenta; Cyan; White ] in let mapcat f = String.concat ~sep:"\n" (List.map colours ~f) in mapcat (fun fg -> mapcat (fun bg -> css fg bg false ^ "\n" ^ css fg bg true)) ;; let term_styler = let prev = ref None in let set_style style os = os (Printf.sprintf "\027[%i;%i%sm" (int_of_colour style.bg + 40) (int_of_colour style.fg + 30) (if style.bold then ";1" else "")) in let close_style os = os "\027[0m" in { start = (fun _ -> prev := None) ; set = (fun os style -> let set_style () = prev := Some style; set_style style os in match !prev with | Some prev' when Draw.Style.compare style prev' <> 0 -> set_style () | None -> set_style () | _ -> ()) ; eol = (fun os -> prev := None; close_style os) ; finish = close_style } ;; let html_escape ?(styler = no_styler) os ctx = let open Draw.In_memory in let bounds = get_bounds ctx in styler.start os; for r = 0 to bounds.h - 1 do for c = 0 to bounds.w - 1 do (* TODO styling *) let code = fst ctx.(r).(c) in styler.set os (snd ctx.(r).(c)); os ("&#" ^ Int.to_string code) done; styler.eol os; os "\n" done; styler.finish os ;; let utf8 ?(styler = no_styler) os ctx = let open Draw.In_memory in let put c = if c <= 0x7f then os (String.init 1 ~f:(fun _ -> Char.of_int_exn c)) else if c <= 0x7FF then os (String.init 2 ~f:(function | 0 -> Char.of_int_exn ((c lsr 6) lor 0b11000000) | _ -> Char.of_int_exn (c land 0b00111111 lor 0b10000000))) else if c <= 0xFFFF then os (String.init 3 ~f:(function | 0 -> Char.of_int_exn ((c lsr 12) lor 0b11100000) | 1 -> Char.of_int_exn ((c lsr 6) land 0b00111111 lor 0b10000000) | _ -> Char.of_int_exn (c land 0b00111111 lor 0b10000000))) else failwith "extend utf-8 writer!" in let bounds = get_bounds ctx in styler.start os; for r = 0 to bounds.h - 1 do for c = 0 to bounds.w - 1 do styler.set os (snd ctx.(r).(c)); put (fst ctx.(r).(c)) done; styler.eol os; os "\n" done; styler.finish os ;;
sectionYPositions = computeSectionYPositions($el), 10)"
x-init="setTimeout(() => sectionYPositions = computeSectionYPositions($el), 10)"
>