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
let width = 8
let height = 16
let glyphs : Bytes.t = Bytes.make (256 * height) '\000'
let unicode : (int, int) Hashtbl.t = Hashtbl.create 256
let () =
String.split_on_char '\n' Vga_font_data.txt
|> List.iter (fun line ->
if String.length line > 40 then begin
let c = int_of_string ("0x" ^ String.sub line 0 2) and u = int_of_string ("0x" ^ String.sub line 3 4) in
let hex = String.sub line (String.length line - 32) 32 in
for y = 0 to height - 1 do
Bytes.set glyphs ((c * height) + y) (Char.chr (int_of_string ("0x" ^ String.sub hex (2 * y) 2)))
done;
if u <> 0 then Hashtbl.replace unicode u c
end)
let row (c : int) (y : int) : int = Char.code (Bytes.unsafe_get glyphs (((c land 255) * height) + y))
let bit (c : int) (x : int) (y : int) : bool = (row c y lsr (7 - x)) land 1 = 1
let of_unicode (u : int) : int option = Hashtbl.find_opt unicode u
let question = Char.code '?'
let decode (s : string) (i : int) : int * int =
let b k = Char.code s.[i + k] in
let n = String.length s - i in
let c0 = b 0 in
let cont k = k < n && b k land 0xC0 = 0x80 in
let cp, len =
if c0 < 0x80 then (c0, 1)
else if c0 land 0xE0 = 0xC0 && cont 1 then (((c0 land 0x1F) lsl 6) lor (b 1 land 0x3F), 2)
else if c0 land 0xF0 = 0xE0 && cont 1 && cont 2 then (((c0 land 0x0F) lsl 12) lor ((b 1 land 0x3F) lsl 6) lor (b 2 land 0x3F), 3)
else if c0 land 0xF8 = 0xF0 && cont 1 && cont 2 && cont 3 then
(((c0 land 0x07) lsl 18) lor ((b 1 land 0x3F) lsl 12) lor ((b 2 land 0x3F) lsl 6) lor (b 3 land 0x3F), 4)
else (-1, 1)
in
((if cp < 0 then question else Option.value ~default:question (of_unicode cp)), len)