-
Notifications
You must be signed in to change notification settings - Fork 7
/
osc_string.ml
185 lines (160 loc) · 5.51 KB
/
osc_string.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
open Rresult
module Input = struct
type t = {
data: string;
mutable pos: int;
}
let current_char input = input.data.[input.pos]
end
exception Not_implemented
(* Strings are padding with 1-4 null characters to make the total
* length a multiple of 4 bytes. *)
let string_padding_of_length length =
4 - (length mod 4)
(* Blobs are padded with 0-3 null characters to make the total
* length a multiple of 4 bytes. *)
let blob_padding_of_length length =
match length mod 4 with
| 0 -> 0
| x -> 4 - x
let int32_chars = 4
module Decode = struct
open Input
let int32 input =
let result = EndianString.BigEndian.get_int32 input.data input.pos in
input.pos <- input.pos + int32_chars;
result
let float32 input =
Int32.float_of_bits (int32 input)
let string input =
(* Look for the first null char after the position marker - this is the
* start of the string's padding. *)
let end_pos = Bytes.index_from input.data input.pos '\000' in
let string_length = end_pos - input.pos in
let padding_length = string_padding_of_length string_length in
(* Read the string, then move the position marker past the string and its
* padding. *)
let result = Bytes.sub input.data input.pos string_length in
input.pos <- input.pos + string_length + padding_length;
result
let blob input =
(* Decode the blob length. *)
let blob_length = Int32.to_int (int32 input) in
let padding_length = blob_padding_of_length blob_length in
(* Read the blob, then move the position marker past the blob and its
* padding. *)
let result = Bytes.sub input.data input.pos blob_length in
input.pos <- input.pos + blob_length + padding_length;
result
let argument input = function
| 'f' -> Ok (Osc.Float32 (float32 input))
| 'i' -> Ok (Osc.Int32 (int32 input))
| 's' -> Ok (Osc.String (string input))
| 'b' -> Ok (Osc.Blob (blob input))
| typetag -> Error (`Unsupported_typetag typetag)
let arguments input =
if current_char input <> ','
then Error `Missing_typetag_string
else begin
(* Decode the typetag string. *)
let typetag_string = string input in
let typetag_count = (Bytes.length typetag_string) - 1 in
(* Decode the arguments, moving along the typetag string to detect the
* type we're trying to decode. Due to the ',' prefix in the typetag
* string, the first typetag is the second character in the typetag
* string. *)
let rec decode typetag_position acc =
if typetag_position > typetag_count
then (Ok acc)
else
argument input typetag_string.[typetag_position]
>>= (fun arg -> decode (typetag_position + 1) (arg :: acc))
in
decode 1 [] >>| List.rev
end
let timetag input =
let seconds = int32 input in
let fraction = int32 input in
match seconds, fraction with
| 0l, 1l -> Osc.Immediate
| _ -> Osc.(Time {seconds; fraction})
let packet input =
match string input with
| "#bundle" -> raise Not_implemented
| address ->
arguments input >>=
(fun args -> Ok (Osc.(Message {address = address; arguments = args})))
end
module Encode = struct
let int32 output i =
let tmp = Bytes.create int32_chars in
EndianString.BigEndian.set_int32 tmp 0 i;
Buffer.add_string output tmp
let float32 output f =
int32 output (Int32.bits_of_float f)
let string output s =
Buffer.add_string output s;
let string_length = Bytes.length s in
let padding_length = string_padding_of_length string_length in
let padding = Bytes.make padding_length '\000' in
Buffer.add_string output padding
let blob output b =
(* Encode the blob length as an int32. *)
let blob_length = Bytes.length b in
int32 output (Int32.of_int blob_length);
(* Encode the blob itself, followed by a suitable amount of padding. *)
Buffer.add_string output b;
let padding_length = blob_padding_of_length blob_length in
if padding_length > 0 then begin
let padding = Bytes.make padding_length '\000' in
Buffer.add_string output padding
end
let argument output = function
| Osc.Float32 f -> float32 output f
| Osc.Int32 i -> int32 output i
| Osc.String s -> string output s
| Osc.Blob b -> blob output b
let arguments output args =
let typetag_of_argument = function
| Osc.Float32 _ -> 'f'
| Osc.Int32 _ -> 'i'
| Osc.String _ -> 's'
| Osc.Blob _ -> 'b'
in
(* Encode the typetags as a string, prefixed with a comma. *)
let typetag_string = Bytes.create ((List.length args) + 1) in
Bytes.set typetag_string 0 ',';
List.iteri
(fun index arg ->
Bytes.set typetag_string (index + 1) (typetag_of_argument arg))
args;
string output typetag_string;
(* Encode the values of the arguments. *)
let rec encode = function
| [] -> ()
| arg :: rest ->
argument output arg;
encode rest
in
encode args
let timetag output =
let open Osc in function
| Immediate ->
int32 output 0l;
int32 output 1l;
| Time {seconds; fraction} ->
int32 output seconds;
int32 output fraction
let packet output = function
| Osc.Bundle _ -> raise Not_implemented
| Osc.Message msg ->
string output msg.Osc.address;
arguments output msg.Osc.arguments
end
let of_packet packet =
let output = Buffer.create 64 in
Encode.packet output packet;
Buffer.contents output
let to_packet data =
let input = Input.({data; pos = 0}) in
Decode.packet input