Permalink
Branch: master
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
719 lines (609 sloc) 17.8 KB
//////project name
//OSCUtils
//////description
//Utility library to encode/decode osc-packets
//inspired by original OSC reference implementation (OSC-Kit)
//and OSC.Net library as shipped with the TUIO-CSharp sample
//from http://reactable.iua.upf.edu/?software
//////licence
//GNU Lesser General Public License (LGPL)
//english: http://www.gnu.org/licenses/lgpl.html
//german: http://www.gnu.de/lgpl-ger.html
//////language/ide
//delphi
//////initial author
//joreg -> joreg@vvvv.org
//additions for FreePascal
//simon -> simonmoscrop@googlemail.com
//////instructions
////for use with FreePascal
//define: FPC
////encoding a single message:
//first create a message: msg := TOSCMessage.Create(address)
//then call msg.AddFloat(value)... to add any number of arguments
//with msg.ToOSCBytes you get the TBytes you can send via an indy10 TidUDPClient.SendBuffer
////encoding a bundle:
//first create a bundle: bundle := TOSCBundle.Create(nil)
//then add any number of packets (i.e. message, bundle) via bundle.Add(packet)
//with bundle.ToOSCBytes you get the TBytes you can send via an indy10 TidUDPClient.SendBuffer
////decoding a string
//use TOSCPacket.Unpack(bytes, Length(bytes)) to create
//TOSCPackets of your osc-bytes (those can be either bundles or single
//messages. if you want to decode several packets at once you can create
//a container bundle first and add the packets you create like this.
//then use msg := FPacket.MatchAddress(address) to find a message with the
//according address in your packet-structure.
//before you now can access the arguments and typetags of a message you have
//to call msg.Decode
//voila.
unit OSCUtils;
interface
uses Classes, Contnrs, SysUtils, System.Generics.Collections;
type
TOSCPacket = class;
TOSCMessage = class;
TOSCPacket = class (TObject)
private
protected
FBytes: TBytes;
function MatchBrackets(pMessage, pAddress: PChar): Boolean;
function MatchList(pMessage, pAddress: PChar): Boolean;
function MatchPattern(pMessage, pAddress: PChar): Boolean;
public
constructor Create(Bytes: TBytes);
function MatchAddress(Address: String): TOSCMessage; virtual; abstract;
function ToOSCBytes: TBytes; virtual; abstract;
procedure Unmatch; virtual; abstract;
class function Unpack(Bytes: TBytes; Count: Integer): TOSCPacket; overload;
class function Unpack(Bytes: TBytes; Offset, Count: Integer; TimeTag: Extended
= 0): TOSCPacket; overload; virtual;
end;
TOSCMessage = class(TOSCPacket)
private
FAddress: string;
FArguments: TList<TBytes>;
FIsDecoded: Boolean;
FMatched: Boolean;
FTimeTag: Extended;
FTypeTagOffset: Integer;
FTypeTags: string;
function GetArgument(Index: Integer): TBytes;
function GetArgumentAsFloat(Index: Integer): Single;
function GetArgumentAsInt(Index: Integer): Integer;
function GetArgumentCount: Integer;
function GetTypeTag(Index: Integer): string;
public
constructor Create(Address: string); overload;
constructor Create(Bytes: TBytes); overload;
destructor Destroy; override;
function AddAsBytes(const TypeTag: Char; const Value: String; const fs:
TFormatSettings): HResult;
procedure AddFloat(Value: Single);
procedure AddInteger(Value: Integer);
procedure AddString(Value: String);
procedure Decode;
function MatchAddress(Address: String): TOSCMessage; override;
function ToOSCBytes: TBytes; override;
procedure Unmatch; override;
class function Unpack(Bytes: TBytes; PacketOffset, Count: Integer; TimeTag:
Extended = 0): TOSCPacket; overload; override;
property Address: string read FAddress write FAddress;
property Argument[Index: Integer]: TBytes read GetArgument;
property ArgumentAsFloat[Index: Integer]: Single read GetArgumentAsFloat;
property ArgumentAsInt[Index: Integer]: Integer read GetArgumentAsInt;
property ArgumentCount: Integer read GetArgumentCount;
property IsDecoded: Boolean read FIsDecoded write FIsDecoded;
property Matched: Boolean read FMatched write FMatched;
property TimeTag: Extended read FTimeTag write FTimeTag;
property TypeTag[Index: Integer]: String read GetTypeTag;
property TypeTagOffset: Integer read FTypeTagOffset write FTypeTagOffset;
end;
TOSCBundle = class(TOSCPacket)
private
FPackets: TObjectList;
public
constructor Create(Bytes: TBytes);
destructor Destroy; override;
procedure Add(const Packet: TOSCPacket);
function MatchAddress(Address: String): TOSCMessage; override;
function ToOSCBytes: TBytes; override;
procedure Unmatch; override;
class function Unpack(Bytes: TBytes; PacketOffset, Count: Integer; TimeTag:
Extended = 0): TOSCPacket; overload; override;
end;
function MakeOSCFloat(value: Single): TBytes;
function MakeOSCInt(value: Integer): TBytes;
function MakeOSCString(value: String): TBytes;
function UnpackInt(Bytes: TBytes; var Offset: Integer): TBytes;
function UnpackString(Bytes: TBytes; var Offset: Integer): TBytes;
function UnpackFloat(Bytes: TBytes; var Offset: Integer): TBytes;
function UnpackAndReturnInt(Bytes: TBytes; var Offset: Integer): Integer;
function UnpackAndReturnFloat(Bytes: TBytes; var Offset: Integer): Single;
const
OSC_OK = 0;
OSC_UNRECOGNIZED_TYPETAG = 1;
OSC_CONVERT_ERROR = 2;
implementation
uses
Math, IdGlobal {$IFNDEF FPC}, WinSock {$ENDIF};
function MakeOSCFloat(value: Single): TBytes;
var
intg: Integer;
begin
intg := PInteger(@value)^;
{$IFDEF FPC}
intg := BEtoN(intg);
{$ELSE}
intg := htonl(intg);
{$ENDIF}
Result := IdGlobal.RawToBytes(intg, SizeOf(intg));
end;
function MakeOSCInt(value: Integer): TBytes;
begin
{$IFDEF FPC}
value := BEtoN(value);
{$ELSE}
value := htonl(value);
{$ENDIF}
Result := IdGlobal.RawToBytes(value, SizeOf(value));
end;
function MakeOSCString(value: String): TBytes;
var i, ln: Integer;
begin
ln := TEncoding.UTF8.GetByteCount(value);
ln := ln + (4 - ln mod 4);
SetLength(Result, ln);
ln := TEncoding.UTF8.GetBytes(value, 1, Length(value), Result, 0);
for i := ln to High(Result) do
result[i] := 0;
end;
function UnpackInt(Bytes: TBytes; var Offset: Integer): TBytes;
var
i: Integer;
begin
SetLength(Result, SizeOf(Integer));
// Copy bytes and change byte order
for i := 0 to High(Result) do
Result[i] := Bytes[Offset + High(Result) - i];
Inc(Offset, SizeOf(Integer));
end;
function UnpackString(Bytes: TBytes; var Offset: Integer): TBytes;
var
off: Integer;
begin
// Strings are null terminated. Find position of null.
off := Offset;
while (off < Length(Bytes)) and (Bytes[off] <> 0) do
Inc(off);
// Retrieve the string.
SetLength(Result, off - Offset);
IdGlobal.CopyTIdBytes(Bytes, Offset, Result, 0, Length(Result));
// Increase the offset by a multiple of 4.
Offset := off + (4 - off mod 4);
end;
function UnpackFloat(Bytes: TBytes; var Offset: Integer): TBytes;
var
//value: Integer;
i: Integer;
begin
SetLength(Result, SizeOf(Single));
// Copy bytes and change byte order
for i := 0 to High(Result) do
begin
Result[i] := Bytes[Offset + High(Result) - i];
end;
Inc(Offset, SizeOf(Single));
end;
function UnpackAndReturnInt(Bytes: TBytes; var Offset: Integer): Integer;
var
resultBytes: TBytes;
begin
resultBytes := UnpackInt(Bytes, Offset);
Result := PInteger(Pointer(resultBytes))^;
end;
function UnpackAndReturnFloat(Bytes: TBytes; var Offset: Integer): Single;
var
resultBytes: TBytes;
begin
resultBytes := UnpackFloat(Bytes, Offset);
Result := PSingle(Pointer(resultBytes))^;
end;
constructor TOSCMessage.Create(Address: string);
begin
FAddress := Address;
Create(nil);
end;
constructor TOSCMessage.Create(Bytes: TBytes);
begin
inherited;
FTypeTags := ',';
FArguments := TList<TBytes>.Create;
FIsDecoded := false;
end;
destructor TOSCMessage.Destroy;
begin
FArguments.Free;
inherited;
end;
function TOSCMessage.AddAsBytes(const TypeTag: Char; const Value: String; const
fs: TFormatSettings): HResult;
begin
Result := OSC_OK;
try
if TypeTag = 'f' then
AddFloat(StrToFloat(Value, fs))
else if TypeTag = 'i' then
AddInteger(StrToInt(Value))
else if TypeTag = 's' then
AddString(Value)
else
Result := OSC_UNRECOGNIZED_TYPETAG;
except on EConvertError do
Result := OSC_CONVERT_ERROR;
end;
end;
procedure TOSCMessage.AddFloat(Value: Single);
begin
FTypeTags := FTypeTags + 'f';
FArguments.Add(MakeOSCFloat(Value));
end;
procedure TOSCMessage.AddInteger(Value: Integer);
begin
FTypeTags := FTypeTags + 'i';
FArguments.Add(MakeOSCInt(Value));
end;
procedure TOSCMessage.AddString(Value: String);
begin
FTypeTags := FTypeTags + 's';
FArguments.Add(MakeOSCString(Value));
end;
procedure TOSCMessage.Decode;
var
i, offset: Integer;
begin
if FIsDecoded then
exit;
offset := FTypeTagOffset;
FTypeTags := TEncoding.ASCII.GetString(UnpackString(FBytes, offset));
for i := 1 to Length(FTypeTags) - 1 do
begin
if FTypeTags[i+1] = 's' then
FArguments.Add(UnpackString(FBytes, offset))
else if FTypeTags[i+1] = 'i' then
FArguments.Add(UnpackInt(FBytes, offset))
else if FTypeTags[i+1] = 'f' then
FArguments.Add(UnpackFloat(FBytes, offset));
end;
FIsDecoded := true;
end;
function TOSCMessage.GetArgument(Index: Integer): TBytes;
begin
Result := FArguments[Index];
end;
function TOSCMessage.GetArgumentAsFloat(Index: Integer): Single;
begin
Result := PSingle(Pointer(FArguments[Index]))^;
end;
function TOSCMessage.GetArgumentAsInt(Index: Integer): Integer;
begin
Result := PInteger(Pointer(FArguments[Index]))^;
end;
function TOSCMessage.GetArgumentCount: Integer;
begin
Result := FArguments.Count;
end;
function TOSCMessage.GetTypeTag(Index: Integer): string;
begin
Result := FTypeTags[Index + 2];
end;
function TOSCMessage.MatchAddress(Address: String): TOSCMessage;
begin
if not FMatched
and MatchPattern(PChar(FAddress), PChar(Address)) then
begin
FMatched := true;
Result := Self
end
else
Result := nil;
end;
function TOSCMessage.ToOSCBytes: TBytes;
var
i: Integer;
resultList: TList<Byte>;
begin
resultList := TList<Byte>.Create;
resultList.AddRange(MakeOSCString(FAddress));
resultList.AddRange(MakeOSCString(FTypeTags));
for i := 0 to FArguments.Count - 1 do
resultList.AddRange(FArguments[i]);
Result := resultList.ToArray();
resultList.Free;
end;
procedure TOSCMessage.Unmatch;
begin
FMatched := false;
end;
class function TOSCMessage.Unpack(Bytes: TBytes; PacketOffset, Count: Integer;
TimeTag: Extended = 0): TOSCPacket;
begin
Result := TOSCMessage.Create(Bytes);
//for now decode address only
(Result as TOSCMessage).Address := TEncoding.ASCII.GetString(UnpackString(Bytes, PacketOffset));
(Result as TOSCMessage).TimeTag := TimeTag;
//save offset for later decoding on demand
(Result as TOSCMessage).TypeTagOffset := PacketOffset;
(Result as TOSCMessage).IsDecoded := false;
end;
constructor TOSCBundle.Create(Bytes: TBytes);
begin
inherited;
FPackets := TObjectList.Create;
FPackets.OwnsObjects := true;
end;
destructor TOSCBundle.Destroy;
begin
FPackets.Free;
inherited;
end;
procedure TOSCBundle.Add(const Packet: TOSCPacket);
begin
FPackets.Add(Packet);
end;
function TOSCBundle.MatchAddress(Address: String): TOSCMessage;
var
i: Integer;
begin
Result := nil;
for i := 0 to FPackets.Count - 1 do
begin
Result := (FPackets[i] as TOSCPacket).MatchAddress(Address);
if Assigned(Result) then
break;
end;
end;
function TOSCBundle.ToOSCBytes: TBytes;
var
i: Integer;
packet: TBytes;
resultList: TList<Byte>;
begin
resultList := TList<Byte>.Create;
resultList.AddRange(MakeOSCString('#bundle'));
resultList.AddRange(TEncoding.UTF8.GetBytes(#0#0#0#0#0#0#0#1)); //immediately
for i := 0 to FPackets.Count - 1 do
begin
packet := (FPackets[i] as TOSCPacket).ToOSCBytes;
resultList.AddRange(MakeOSCInt(Length(packet)));
resultList.AddRange(packet);
end;
Result := resultList.ToArray();
resultList.Free;
end;
procedure TOSCBundle.Unmatch;
var
i: Integer;
begin
for i := 0 to FPackets.Count - 1 do
(FPackets[i] as TOSCPacket).UnMatch;
end;
class function TOSCBundle.Unpack(Bytes: TBytes; PacketOffset, Count: Integer;
TimeTag: Extended = 0): TOSCPacket;
var
packetLength: Integer;
tt1, tt2: Cardinal;
begin
Result := TOSCBundle.Create(Bytes);
//advance the '#bundle' string
UnpackString(Bytes, PacketOffset);
//advance the timestamp
tt1 := Cardinal(UnpackAndReturnInt(Bytes, PacketOffset));
tt2 := Cardinal(UnpackAndReturnInt(Bytes, PacketOffset));
TimeTag := tt1 + tt2 / power(2, 32);
while PacketOffset < Count do
begin
packetLength := UnpackAndReturnInt(Bytes, PacketOffset);
//note: PacketOffset is always from the very beginning of Bytes!
//not the beginning of the current packet.
(Result as TOSCBundle).Add(TOSCPacket.Unpack(Bytes, PacketOffset, PacketOffset + packetLength, TimeTag));
Inc(PacketOffset, packetLength);
end;
end;
constructor TOSCPacket.Create(Bytes: TBytes);
begin
FBytes := Bytes;
end;
// we know that pattern[0] == '[' and test[0] != 0 */
function TOSCPacket.MatchBrackets(pMessage, pAddress: PChar): Boolean;
var
negated: Boolean;
p, p1, p2: PChar;
begin
p := pMessage;
Result := false;
negated := false;
Inc(pMessage);
if pMessage^ = #0 then
begin
//LogWarningFMT('Unterminated [ in message: %s', [FInput[0]]);
Dec(pMessage);
exit;
end;
if pMessage^ = '!' then
begin
negated := true;
Inc(p);
end;
Dec(pMessage);
Result := negated;
while p^ <> ']' do
begin
if p^ = #0 then
begin
//LogWarningFMT('Unterminated [ in message: %s', [FInput[0]]);
exit;
end;
p1 := p + 1; // sizeOf(PChar);
p2 := p1 + 1; //sizeOf(PChar);
if (p1^ = '-')
and (p2^ <> #0) then
if (Ord(pAddress^) >= Ord(p^))
and (Ord(pAddress^) <= Ord(p2^)) then
begin
Result := not negated;
break;
end;
if p^ = pAddress^ then
begin
Result := not negated;
break;
end;
Inc(p);
end;
if Result = false then
exit;
while p^ <> ']' do
begin
if p^ = #0 then
begin
//LogWarningFMT('Unterminated [ in message: %s', [FInput[0]]);
exit;
end;
Inc(p);
end;
Inc(p);
pMessage := p;
Inc(pAddress);
Result := MatchPattern(p, pAddress);
end;
function TOSCPacket.MatchList(pMessage, pAddress: PChar): Boolean;
var
p, tp: PChar;
begin
Result := false;
p := pMessage;
tp := pAddress;
while p^ <> '}' do
begin
if p^ = #0 then
begin
//LogWarningFMT('Unterminated { in message: %s', [FInput[0]]);
exit;
end;
Inc(p);
end;
// for(restOfPattern = pattern; *restOfPattern != '}'; restOfPattern++) {
// if (*restOfPattern == 0) {
// OSCWarning("Unterminated { in pattern \".../%s/...\"", theWholePattern);
// return FALSE;
// }
//}
Inc(p); // skip close curly brace
Inc(pMessage); // skip open curly brace
while true do
begin
if pMessage^ = ',' then
begin
if MatchPattern(p, tp) then
begin
Result := true;
pMessage := p;
pAddress := tp;
exit;
end
else
begin
tp := pAddress;
Inc(pMessage);
end;
end
else if pMessage^ = '}' then
begin
Result := MatchPattern(p, tp);
pMessage := p;
pAddress := tp;
exit;
end
else if pMessage^ = tp^ then
begin
Inc(pMessage);
Inc(tp);
end
else
begin
tp := pAddress;
while (pMessage^ <> ',')
and (pMessage^ <> '}') do
Inc(pMessage);
if pMessage^ = ',' then
Inc(pMessage);
end;
end;
end;
function TOSCPacket.MatchPattern(pMessage, pAddress: PChar): Boolean;
begin
if (pMessage = nil)
or (pMessage^ = #0) then
begin
Result := pAddress^ = #0;
exit;
end;
if pAddress^ = #0 then
begin
if pMessage^ = '*' then
begin
Result := MatchPattern(pMessage + 1, pAddress);
exit;
end
else
begin
Result := false;
exit;
end;
end;
case pMessage^ of
#0 : Result := pAddress^ = #0;
'?': Result := MatchPattern(pMessage + 1, pAddress + 1);
'*':
begin
if MatchPattern(pMessage + 1, pAddress) then
Result := true
else
Result := MatchPattern(pMessage, pAddress + 1);
end;
']','}':
begin
//LogWarningFMT('Spurious %s in message: %s', [pMessage^, FInput[0]]);
Result := false;
end;
'[': Result := MatchBrackets(pMessage, pAddress);
'{': Result := MatchList(pMessage, pAddress);
{'\\':
begin
if pMessage^ + 1 = #0 then
Result := pAddress^ = #0
else if pMessage^ + 1 = pAddress^
Result := MatchPattern(pMessage + 2, pAddress + 1)
else
Result := false;
end; }
else
if pMessage^ = pAddress^ then
Result := MatchPattern(pMessage + 1,pAddress + 1)
else
Result := false;
end;
end;
class function TOSCPacket.Unpack(Bytes: TBytes; Count: Integer): TOSCPacket;
begin
Result := UnPack(Bytes, 0, Count);
end;
class function TOSCPacket.Unpack(Bytes: TBytes; Offset, Count: Integer;
TimeTag: Extended = 0): TOSCPacket;
begin
if Char(Bytes[Offset]) = '#' then
Result := TOSCBundle.UnPack(Bytes, Offset, Count)
else
Result := TOSCMessage.UnPack(Bytes, Offset, Count, TimeTag);
end;
end.