Permalink
Cannot retrieve contributors at this time
Join GitHub today
GitHub is home to over 31 million developers working together to host and review code, manage projects, and build software together.
Sign up
Fetching contributors…

//////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. |