Object subclass: #OSCPacket instanceVariableNames: 'byteStream' classVariableNames: '' package: 'OSC-Kernel'! !OSCPacket methodsFor: 'action' stamp: 'mga 9/17/2006 19:17'! sendToYourself self sendTo: NetNameResolver localHostAddress port: 57123! ! !OSCPacket methodsFor: 'action'! sendTo: aByteArray port: aPort "Take care, A byte array is not a string. If you want to send to e.g. '192.168.0.2' sendToAddressString: port: instead But use this one if you want to be fast." | aSocket | Socket initializeNetwork. aSocket := Socket newUDP. aSocket sendUDPData: self byteArray toHost: aByteArray port: aPort; close; destroy! ! !OSCPacket methodsFor: 'action' stamp: 'mga 9/17/2006 19:17'! sendToAddressString: anAddressString port: aPort self sendTo: ((anAddressString findTokens: '.') collect: [:e | e asNumber]) asByteArray port: aPort! ! !OSCPacket methodsFor: 'initialization' stamp: 'gk 5/18/2021 18:51'! initializeFor: somePackets byteStream := (OSCStream on: '') yourself. self print: somePackets onOSCStream: byteStream! ! !OSCPacket methodsFor: 'accessing' stamp: 'mga 3/28/2005 09:24'! byteArray ^self byteStream binary contents! ! !OSCPacket methodsFor: 'accessing' stamp: 'mga 3/28/2005 07:56'! oSCSize ^self byteArray size! ! !OSCPacket methodsFor: 'accessing' stamp: 'mga 3/16/2005 08:58'! byteStream ^byteStream! ! !OSCPacket methodsFor: 'printing' stamp: 'mga 6/24/2000 14:09'! print: somePackets onOSCStream: aStream self subclassResponsibility! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! OSCPacket class instanceVariableNames: ''! !OSCPacket class methodsFor: 'access to cache' stamp: 'StephaneDucasse 9/29/2012 22:59'! for: somePackets ^ self new initializeFor: somePackets ! ! OSCPacket subclass: #OSCBundle instanceVariableNames: 'packets' classVariableNames: '' package: 'OSC-Kernel'! !OSCBundle methodsFor: 'printing' stamp: 'StephaneDucasse 9/29/2012 23:02'! printTimeTagOnOSCStream: aStream "Not yet implemented, just print 8 empty bytes" 8 timesRepeat: [ aStream nextPut: 0 ]! ! !OSCBundle methodsFor: 'printing' stamp: 'StephaneDucasse 9/29/2012 23:02'! print: somePackets onOSCStream: aStream '#bundle' printOnOSCStream: aStream. self printTimeTagOnOSCStream: aStream. somePackets do: [ :aPacket | aPacket oSCSize printOnOSCStream: aStream. aStream nextPutAll: aPacket byteArray ] ! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! OSCBundle class instanceVariableNames: ''! !OSCBundle class methodsFor: 'examples' stamp: 'mga 6/24/2000 14:07'! example1 ^self for: {OSCMessage example1 . OSCMessage example2} ! ! !OSCBundle class methodsFor: 'examples' stamp: 'mga 6/24/2000 14:08'! example2 ^self for: {OSCBundle example1 . OSCMessage example3}! ! OSCPacket subclass: #OSCMessage instanceVariableNames: '' classVariableNames: '' package: 'OSC-Kernel'! !OSCMessage methodsFor: 'printing' stamp: 'StephaneDucasse 9/29/2012 23:03'! printValues: someValues onOSCStream: aStream someValues do: [ :each | each printOnOSCStream: aStream ] ! ! !OSCMessage methodsFor: 'printing' stamp: 'mga 3/29/2005 21:37'! print: someArguments onOSCStream: aStream | someParams | self printAddress: someArguments first onOSCStream: aStream. "Put the comma, also parameterless messages have one" aStream nextPut: 44. someParams := someArguments copyFrom: 2 to: someArguments size. self printTypesOf: someParams on: aStream; printValues: someParams onOSCStream: aStream ! ! !OSCMessage methodsFor: 'printing' stamp: 'StephaneDucasse 9/29/2012 23:02'! printAddress: anAddress onOSCStream: aStream anAddress printOnOSCStream: aStream ! ! !OSCMessage methodsFor: 'printing' stamp: 'StephaneDucasse 9/29/2012 23:03'! printTypesOf: someValues on: aStream |aNullChar| someValues isEmpty ifTrue: [^self]. aNullChar := Character value: 0. someValues do: [ :each | each printTypeOnOSCStream: aStream ]. (4 - (aStream position \\ 4)) timesRepeat: [ aStream nextPut: aNullChar ] ! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! OSCMessage class instanceVariableNames: ''! !OSCMessage class methodsFor: 'examples' stamp: 'mga 6/24/2000 14:19'! example3 ^self for: {'/example3' . 20 . 30 . 'bla'}! ! !OSCMessage class methodsFor: 'examples' stamp: 'mga 3/30/2005 04:23'! exampleBerkeley3Message ^{'/foo' . 1000 . -1 . 'hello' .1.125 . 4.0625 }! ! !OSCMessage class methodsFor: 'examples' stamp: 'mga 3/29/2005 21:19'! exampleSCIncreaseVolume ^self for: self increaseVolumeMessage! ! !OSCMessage class methodsFor: 'examples' stamp: 'mga 3/29/2005 21:19'! exampleSCRun "self exampleSCRun sendTo: '10.0.1.2' port: 22" ^self for: {'/sc/run'}! ! !OSCMessage class methodsFor: 'examples' stamp: 'mga 6/24/2000 14:18'! example2 ^self for: {'/example2' . 'tester' . 10.4}! ! !OSCMessage class methodsFor: 'examples' stamp: 'mga 3/29/2005 21:19'! exampleBerkeley2Message ^{'/foo' . 1000 . -1 . 'hello' . 1.234 . 5.678}! ! !OSCMessage class methodsFor: 'examples' stamp: 'mga 3/30/2005 04:23'! exampleBerkeley3 ^self for: self exampleBerkeley3Message! ! !OSCMessage class methodsFor: 'examples' stamp: 'mga 3/29/2005 21:19'! exampleBerkeley2 ^self for: self exampleBerkeley2Message! ! !OSCMessage class methodsFor: 'examples' stamp: 'mga 6/24/2000 14:18'! example1 ^self for: {'/example1' . 100}! ! !OSCMessage class methodsFor: 'examples' stamp: 'mga 3/29/2005 21:20'! exampleSCStop ^self for: {'/sc/stop'}! ! !OSCMessage class methodsFor: 'examples' stamp: 'mga 3/29/2005 21:20'! increaseVolumeMessage ^{'/sc/mixer/volume' . 1 . 1.0}! ! !OSCMessage class methodsFor: 'examples' stamp: 'mga 3/29/2005 21:19'! exampleSCA ^self for: {'a' . 1 . 0.2}! ! !OSCMessage class methodsFor: 'examples' stamp: 'mga 3/29/2005 21:19'! exampleSCDecreaseVolume ^self for: {'/sc/mixer/volume' . 1 . 0.2}! ! Object subclass: #OSCParser instanceVariableNames: 'byteStream message types' classVariableNames: '' package: 'OSC-Kernel'! !OSCParser methodsFor: 'action' stamp: 'SimonHolland 9/15/2007 10:28'! parseBlob ^ nil! ! !OSCParser methodsFor: 'action' stamp: 'mga 3/28/2005 09:51'! parseTypes | next | byteStream atEnd ifTrue: [^self]. next:= byteStream next. next = (Character value: 0) ifTrue: [ ((4 - (byteStream position \\ 4)) \\ 4) timesRepeat: [byteStream next]. ^self]. ('ifsb' includes: next) ifTrue: [types add: next]. self parseTypes! ! !OSCParser methodsFor: 'accessing' stamp: 'SimonHolland 9/15/2007 10:29'! parseHeader message add: ((byteStream ascii upTo: $, ) copyWithout: (Character value: 0)) ! ! !OSCParser methodsFor: 'accessing' stamp: 'mga 3/27/2005 18:26'! parseInt32 message add: byteStream binary nextInt32! ! !OSCParser methodsFor: 'accessing' stamp: 'mga 3/27/2005 18:26'! parseValues | aTypeStream | aTypeStream := ReadStream on: types. [aTypeStream atEnd] whileFalse: [self parseNextValueTyped: aTypeStream next]! ! !OSCParser methodsFor: 'accessing' stamp: 'mga 3/27/2005 18:28'! parse self parseHeader; parseTypes; parseValues. ^message asArray! ! !OSCParser methodsFor: 'accessing' stamp: 'mga 3/28/2005 09:52'! parseNextValueTyped: aType aType = $i ifTrue: [^self parseInt32]. aType = $f ifTrue: [^self parseFloat]. aType = $s ifTrue: [^self parseString]. aType = $b ifTrue: [^self parseBlob] ! ! !OSCParser methodsFor: 'accessing' stamp: 'mga 3/27/2005 18:26'! parseFloat message add: (Float fromIEEE32Bit: (byteStream binary nextNumber: 4))! ! !OSCParser methodsFor: 'parse' stamp: 'SimonHolland 9/15/2007 10:28'! parseString message add: (byteStream ascii upTo: (Character value: 0)). (4 - (byteStream position))\\4 timesRepeat: [ byteStream next ] ! ! !OSCParser methodsFor: 'initialization' stamp: 'mga 3/27/2005 18:26'! initializeFor: aByteStream byteStream := aByteStream. message := OrderedCollection new. types := OrderedCollection new.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! OSCParser class instanceVariableNames: ''! !OSCParser class methodsFor: 'parse' stamp: 'StephaneDucasse 9/29/2012 22:58'! parse: aByteStream | messageArrays messageArray | messageArrays := OrderedCollection new. [ aByteStream atEnd] whileFalse: [ messageArray := (self new initializeFor: aByteStream) parse. messageArray ifNotNil: [ messageArrays add: messageArray asArray ]]. ^messageArrays! ! Object subclass: #OSCServer instanceVariableNames: 'process socket messageQueue responsePeriod' classVariableNames: '' package: 'OSC-Kernel'! !OSCServer methodsFor: 'initialize-release' stamp: 'mga 3/27/2005 22:49'! terminate socket notNil ifTrue: [socket destroy]. process notNil ifTrue: [process terminate]! ! !OSCServer methodsFor: 'initialize-release' stamp: 'SimonHolland 9/15/2007 12:43'! initialize super initialize. messageQueue := SharedQueue new. responsePeriod := 10.! ! !OSCServer methodsFor: 'action' stamp: 'gk 5/18/2021 18:51'! listenOnPort: aPort | dataStream buf anArray sizeOfBuf | self terminate. socket := (Socket udpCreateIfFail: [self error: 'Problems connecting to:',aPort asString]) setPort: aPort. process := [ [dataStream := (OSCStream on: (String new: 2048)) binary;yourself. buf := String new: 2048. anArray:=socket receiveUDPDataInto: buf. sizeOfBuf := anArray first. 1 to: sizeOfBuf do: [:ii | dataStream nextPut: (buf at: ii)]. dataStream reset. sizeOfBuf > 0 ifTrue: [ self receive: dataStream] ] repeat ] forkAt: Processor userBackgroundPriority. ! ! !OSCServer methodsFor: 'action' stamp: 'StephaneDucasse 9/29/2012 23:01'! receive:aByteStream (OSCParser parse: aByteStream ascii) do: [:eachMessageArray | messageQueue nextPut:eachMessageArray ]. Delay forMilliseconds: responsePeriod.! ! !OSCServer methodsFor: 'accessing' stamp: 'mga 9/17/2006 18:24'! nextMessage ^ messageQueue next! ! !OSCServer methodsFor: 'testing' stamp: 'mga 9/17/2006 18:25'! hasMessage ^messageQueue isEmpty not! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! OSCServer class instanceVariableNames: ''! !OSCServer class methodsFor: 'as yet unclassified' stamp: 'mga 3/15/2005 23:45'! listenOnPort: aPort "(self listenOnPort: 7010) inspect" ^self new listenOnPort: aPort! ! ReadWriteStream subclass: #OSCStream instanceVariableNames: 'isBinary' classVariableNames: '' package: 'OSC'! !OSCStream commentStamp: '' prior: 0! A simulation of a FileStream, but living totally in memory. Hold the contents of a file or web page from the network. Can then fileIn like a normal FileStream. Need to be able to switch between binary and text, as a FileStream does, without recopying the whole collection. Convert to binary upon input and output. Always keep as text internally.! !OSCStream methodsFor: 'writing' stamp: 'ar 9/1/2009 00:22'! nextPutAll: aCollection "Optimized for ByteArrays" aCollection class == ByteArray ifTrue:[^super nextPutAll: aCollection asString]. ^super nextPutAll: aCollection! ! !OSCStream methodsFor: 'writing' stamp: 'ar 9/1/2009 00:23'! next: anInteger putAll: aCollection startingAt: startIndex "Optimized for ByteArrays" aCollection class == ByteArray ifTrue:[^super next: anInteger putAll: aCollection asString startingAt: startIndex]. ^super next: anInteger putAll: aCollection startingAt: startIndex! ! !OSCStream methodsFor: 'properties-setting' stamp: 'tk 10/1/1998 11:54'! setFileTypeToObject "do nothing. We don't have a file type"! ! !OSCStream methodsFor: 'testing' stamp: 'tk 6/20/97 19:47'! isBinary ^ isBinary! ! !OSCStream methodsFor: 'converting' stamp: 'tk 2/4/2000 09:15'! asBinaryOrTextStream ^ self! ! !OSCStream methodsFor: 'positioning' stamp: 'tk 6/21/97 13:04'! reset "Set the receiver's position to the beginning of the sequence of objects." super reset. isBinary ifNil: [isBinary := false]. collection class == ByteArray ifTrue: ["Store as String and convert as needed." collection := collection asString. isBinary := true]. ! ! !OSCStream methodsFor: 'accessing' stamp: 'ul 2/27/2017 00:41'! upTo: anObject "fast version using indexOf:" | start end | isBinary ifTrue: [ anObject isInteger ifFalse: [ ^self upToEnd ] ] ifFalse: [ anObject isCharacter ifFalse: [ ^self upToEnd ] ]. start := position + 1. end := collection indexOf: anObject asCharacter startingAt: start. "not present--return rest of the collection" (end = 0 or: [end > readLimit]) ifTrue: [ ^self upToEnd ]. "skip to the end and return the data passed over" position := end. ^((isBinary ifTrue: [ ByteArray ] ifFalse: [ String ]) new: end - start) replaceFrom: 1 to: end - start with: collection startingAt: start! ! !OSCStream methodsFor: 'accessing' stamp: 'nice 3/19/2010 19:06'! nextPut: charOrByte ^super nextPut: charOrByte asCharacter! ! !OSCStream methodsFor: 'accessing' stamp: 'jm 11/4/97 08:25'! contentsOfEntireFile "For compatibility with file streams." ^ self contents! ! !OSCStream methodsFor: 'accessing' stamp: 'tk 6/20/97 19:46'! binary isBinary := true! ! !OSCStream methodsFor: 'accessing' stamp: 'tk 6/25/97 13:22'! ascii isBinary := false! ! !OSCStream methodsFor: 'accessing' stamp: 'ls 3/27/2000 22:24'! next: n into: aCollection startingAt: startIndex "Read n objects into the given collection. Return aCollection or a partial copy if less than n elements have been read." "Overriden for efficiency" | max | max := (readLimit - position) min: n. aCollection replaceFrom: startIndex to: startIndex+max-1 with: collection startingAt: position+1. position := position + max. max = n ifTrue:[^aCollection] ifFalse:[^aCollection copyFrom: 1 to: startIndex+max-1]! ! !OSCStream methodsFor: 'accessing' stamp: 'ar 4/10/2005 19:27'! upToEnd "Must override to get class right." | newArray | newArray := (isBinary ifTrue: [ByteArray] ifFalse: [ByteString]) new: self size - self position. ^ self nextInto: newArray! ! !OSCStream methodsFor: 'accessing' stamp: 'ul 7/2/2018 20:24'! next isBinary ifFalse: [ ^super next ]. ^super next ifNotNil: [ :character | character asInteger ]! ! !OSCStream methodsFor: 'accessing' stamp: 'ar 4/10/2005 19:26'! next: anInteger "Answer the next anInteger elements of my collection. Must override to get class right." | newArray | newArray := (isBinary ifTrue: [ByteArray] ifFalse: [ByteString]) new: anInteger. ^ self nextInto: newArray! ! !OSCStream methodsFor: 'accessing' stamp: 'nice 3/16/2010 23:06'! readInto: aCollection startingAt: startIndex count: n "Read n objects into the given collection. Return number of elements that have been read." "Overriden for efficiency" | max | max := (readLimit - position) min: n. aCollection replaceFrom: startIndex to: startIndex+max-1 with: collection startingAt: position+1. position := position + max. ^max! ! !OSCStream methodsFor: 'accessing' stamp: 'nice 7/28/2014 22:40'! peekLast "Return that item just put at the end of the stream" ^ position > 0 ifTrue: [self isBinary ifTrue: [(collection at: position) asInteger] ifFalse: [(collection at: position) asCharacter]] ifFalse: [nil]! ! !OSCStream methodsFor: 'accessing' stamp: 'tk 6/20/97 19:47'! text isBinary := false! ! !OSCStream methodsFor: 'accessing' stamp: 'tk 6/21/97 12:49'! contents "Answer with a copy of my collection from 1 to readLimit." | newArray | isBinary ifFalse: [^ super contents]. "String" readLimit := readLimit max: position. newArray := ByteArray new: readLimit. ^ newArray replaceFrom: 1 to: readLimit with: collection startingAt: 1.! ! TestCase subclass: #OSCFloatTest instanceVariableNames: '' classVariableNames: '' package: 'OSC-Tests'! !OSCFloatTest methodsFor: 'tests' stamp: 'gk 5/18/2021 18:51'! testPrintOnOSCStream " self debug: #testPrintOnOSCStream " |aByteArray aStream| aStream := (OSCStream on: '') binary. aByteArray := ((OSCStream on: '') binary; nextPut: 65; nextPut: 44; nextPut: 27; nextPut: 113; contents). 10.7567 printOnOSCStream: aStream. self assert: ( aStream contents = aByteArray)! ! TestCase subclass: #OSCMessageTest instanceVariableNames: '' classVariableNames: '' package: 'OSC-Tests'! !OSCMessageTest methodsFor: 'tests' stamp: 'StephaneDucasse 9/29/2012 23:04'! testByteArrayRun " self debug: #testByteArrayRun " self assert: (OSCMessage exampleSCRun byteArray = ('/sc/run',(String with: (Character value: 0) with: $,)) asByteArray)! ! !OSCMessageTest methodsFor: 'tests' stamp: 'StephaneDucasse 9/29/2012 23:04'! testByteArrayDecreaseVolume "self debug: #testByteArrayDecreaseVolume" |aByteArray| aByteArray := #(47 115 99 47 109 105 120 101 114 47 118 111 108 117 109 101 0 0 0 0 44 105 102 0 0 0 0 1 62 76 204 205) asByteArray. self assert: (OSCMessage exampleSCDecreaseVolume byteArray = aByteArray)! ! !OSCMessageTest methodsFor: 'tests' stamp: 'StephaneDucasse 9/29/2012 23:04'! testExampleBerkeley2 "See http://www.cnmat.berkeley.edu/OpenSoundControl/OSC-spec-examples.html" " self debug: #testExampleBerkeley2 " | aByteArray | aByteArray := #( 16r2F 16r66 16r6F 16r6F 0 0 0 0 16r2C 16r69 16r69 16r73 16r66 16r66 0 0 0 0 3 16rE8 16rFF 16rFF 16rFF 16rFF 16r68 16r65 16r6C 16r6C 16r6F 0 0 0 16r3F 16r9D 16rF3 16rB6 16r40 16rB5 16rB2 16r2D ) asByteArray. self assert: (OSCMessage exampleBerkeley2 byteArray = aByteArray)! ! !OSCMessageTest methodsFor: 'tests' stamp: 'StephaneDucasse 9/29/2012 23:04'! testByteArrayStop " self debug: #testByteArrayStop " self assert: (OSCMessage exampleSCStop byteArray = ('/sc/stop',((String new: 4 withAll: (Character value: 0)),',')) asByteArray) ! ! !OSCMessageTest methodsFor: 'tests' stamp: 'StephaneDucasse 9/29/2012 23:04'! testByteArrayIncreaseVolume "self debug: #testByteArrayIncreaseVolume" | aByteArray | aByteArray := #(47 115 99 47 109 105 120 101 114 47 118 111 108 117 109 101 0 0 0 0 44 105 102 0 0 0 0 1 63 128 0 0) asByteArray. self assert: (OSCMessage exampleSCIncreaseVolume byteArray = aByteArray)! ! TestCase subclass: #OSCParserTest instanceVariableNames: 'server' classVariableNames: '' package: 'OSC-Tests'! !OSCParserTest methodsFor: 'tests' stamp: 'SimonHolland 9/21/2007 23:08'! testParseIncreaseVolumeMessage "self debug: #testParseIncreaseVolumeMessage" self assert: ((OSCParser parse: OSCMessage exampleSCIncreaseVolume byteStream reset) first = OSCMessage increaseVolumeMessage)! ! !OSCParserTest methodsFor: 'tests' stamp: 'SimonHolland 9/21/2007 23:08'! testParseExampleBerkely3Message "self debug: #testParseExampleBerkely3Message" self assert: ((OSCParser parse: OSCMessage exampleBerkeley3 byteStream reset) first = OSCMessage exampleBerkeley3Message )! ! !OSCParserTest methodsFor: 'tests' stamp: 'SimonHolland 9/21/2007 23:07'! testParse "self debug: #testParse" self assert: ((OSCParser parse: OSCMessage exampleSCIncreaseVolume byteStream reset) first = OSCMessage increaseVolumeMessage)! ! TestCase subclass: #OSCParserTest2 instanceVariableNames: 'numberArray sampleDataStream messages' classVariableNames: '' package: 'OSC-Tests'! !OSCParserTest2 commentStamp: 'SimonHolland 9/15/2007 11:54' prior: 0! This should ideally be separated out into more & finer tests, but for the moment, this tests for at least two possible problems in one combined test. (a) When several incoming messages arrive in a single bundle, or more than one bundle arrives at once, all messages need to be parsed. (b) Incoming OSC packets can eaily be in excess of 1024 bytes . OSCServer should be able to accomodate this.! !OSCParserTest2 methodsFor: 'tests' stamp: 'StephaneDucasse 9/29/2012 23:05'! testParseAllInBundle self assert: (messages size = 13 ) . self assert: ((messages at: 2) second = 'alive') . self assert: ((messages at: 12) second = 'set') . self assert: ((messages at: 13) second = 'fseq') . ! ! !OSCParserTest2 methodsFor: 'accessing' stamp: 'SimonHolland 9/9/2007 00:25'! sampleDataStream: anObject sampleDataStream := anObject! ! !OSCParserTest2 methodsFor: 'accessing' stamp: 'SimonHolland 9/9/2007 00:25'! numberArray: anObject numberArray := anObject! ! !OSCParserTest2 methodsFor: 'accessing' stamp: 'SimonHolland 9/9/2007 00:25'! numberArray ^ numberArray! ! !OSCParserTest2 methodsFor: 'accessing' stamp: 'SimonHolland 9/9/2007 00:25'! sampleDataStream ^ sampleDataStream! ! !OSCParserTest2 methodsFor: 'setup' stamp: 'gk 5/18/2021 18:51'! sampleDataStreamFromArray: anArray | data stream | data := ByteArray newFrom: anArray. stream := (OSCStream on: (String new: 2048)) binary; yourself. data do: [ :each | stream nextPut: each ]. stream reset. ^ stream binary ! ! !OSCParserTest2 methodsFor: 'setup' stamp: 'SimonHolland 9/15/2007 11:15'! setUp self setUpNumberArray. self sampleDataStream: ( self sampleDataStreamFromArray: numberArray). messages := OSCParser parse: self sampleDataStream ascii .! ! !OSCParserTest2 methodsFor: 'setup' stamp: 'SimonHolland 9/9/2007 00:22'! setUpNumberArray numberArray := #(35 98 117 110 100 108 101 0 0 0 0 0 0 0 0 1 0 0 0 32 47 116 117 105 111 47 50 68 111 98 106 0 44 115 115 0 115 111 117 114 99 101 0 0 118 105 115 105 111 110 0 0 0 0 0 76 47 116 117 105 111 47 50 68 111 98 106 0 44 115 105 105 105 105 105 105 105 105 105 105 0 0 0 0 97 108 105 118 101 0 0 0 0 0 0 42 0 0 0 43 0 0 0 44 0 0 0 45 0 0 0 46 0 0 0 47 0 0 0 48 0 0 0 49 0 0 0 50 0 0 0 51 0 0 0 72 47 116 117 105 111 47 50 68 111 98 106 0 44 115 105 105 102 102 102 102 102 102 102 102 0 0 0 0 115 101 116 0 0 0 0 42 0 0 0 14 63 88 136 237 63 47 122 89 62 37 252 84 61 115 94 16 60 154 81 117 0 0 0 0 186 128 127 210 0 0 0 0 0 0 0 72 47 116 117 105 111 47 50 68 111 98 106 0 44 115 105 105 102 102 102 102 102 102 102 102 0 0 0 0 115 101 116 0 0 0 0 43 0 0 0 13 63 88 151 24 63 102 3 195 62 1 60 116 61 137 156 31 60 130 116 93 0 0 0 0 186 105 27 53 0 0 0 0 0 0 0 72 47 116 117 105 111 47 50 68 111 98 106 0 44 115 105 105 102 102 102 102 102 102 102 102 0 0 0 0 115 101 116 0 0 0 0 44 0 0 0 7 63 23 3 240 63 92 135 87 61 238 4 233 61 149 61 24 0 0 0 0 0 0 0 0 186 182 82 171 0 0 0 0 0 0 0 72 47 116 117 105 111 47 50 68 111 98 106 0 44 115 105 105 102 102 102 102 102 102 102 102 0 0 0 0 115 101 116 0 0 0 0 45 0 0 0 10 63 56 107 155 63 97 75 217 61 226 44 41 62 17 0 62 60 161 91 39 0 0 0 0 59 13 245 244 0 0 0 0 0 0 0 72 47 116 117 105 111 47 50 68 111 98 106 0 44 115 105 105 102 102 102 102 102 102 102 102 0 0 0 0 115 101 116 0 0 0 0 46 0 0 0 1 62 159 147 223 63 82 44 101 61 217 161 105 61 147 225 210 0 0 0 0 0 0 0 0 186 211 195 233 0 0 0 0 0 0 0 72 47 116 117 105 111 47 50 68 111 98 106 0 44 115 105 105 102 102 102 102 102 102 102 102 0 0 0 0 115 101 116 0 0 0 0 47 0 0 0 4 62 232 110 187 63 87 110 53 61 253 117 41 61 151 241 117 0 0 0 0 0 0 0 0 186 198 7 73 0 0 0 0 0 0 0 72 47 116 117 105 111 47 50 68 111 98 106 0 44 115 105 105 102 102 102 102 102 102 102 102 0 0 0 0 115 101 116 0 0 0 0 48 0 0 0 5 62 241 108 216 63 29 239 197 62 20 220 212 61 147 100 218 0 0 0 0 0 0 0 0 186 164 190 84 0 0 0 0 0 0 0 72 47 116 117 105 111 47 50 68 111 98 106 0 44 115 105 105 102 102 102 102 102 102 102 102 0 0 0 0 115 101 116 0 0 0 0 49 0 0 0 8 63 25 248 194 63 36 28 76 62 18 63 84 61 136 42 109 0 0 0 0 0 0 0 0 186 172 239 184 0 0 0 0 0 0 0 72 47 116 117 105 111 47 50 68 111 98 106 0 44 115 105 105 102 102 102 102 102 102 102 102 0 0 0 0 115 101 116 0 0 0 0 50 0 0 0 11 63 57 145 158 63 41 213 19 62 29 206 148 61 131 164 93 60 178 155 39 0 0 0 0 186 140 41 253 0 0 0 0 0 0 0 72 47 116 117 105 111 47 50 68 111 98 106 0 44 115 105 105 102 102 102 102 102 102 102 102 0 0 0 0 115 101 116 0 0 0 0 51 0 0 0 2 62 172 214 28 63 23 74 151 62 9 116 116 61 137 202 171 60 188 34 233 0 0 0 0 186 170 24 46 0 0 0 0 0 0 0 28 47 116 117 105 111 47 50 68 111 98 106 0 44 115 105 0 102 115 101 113 0 0 0 0 0 0 6 70). ! ! !OSCParserTest2 methodsFor: 'testSuite' stamp: 'StephaneDucasse 9/29/2012 23:06'! testSuite | suite | suite := TestSuite named: 'Parse the Full message'. suite addTest: (OSCParserTest2 selector: #testParseAllInBundle). ^ suite ! ! TestCase subclass: #OSCParserTest3 instanceVariableNames: 'string endingNumberArray startingNumberArray numberArrays streams parsedMessages' classVariableNames: '' package: 'OSC-Tests'! !OSCParserTest3 commentStamp: 'SimonHolland 9/15/2007 11:55' prior: 0! After the null that terminates a string, a well-formed incoming OSC message stream will have been padded with nulls if needed to reach a 32-bit word boundary, as per the OSC specification. This test checks that the parser handles this OK wherever the boundary may fall for a particular string in an incoming message.! !OSCParserTest3 methodsFor: 'testSuite' stamp: 'StephaneDucasse 9/29/2012 23:06'! testSuite | suite | suite := TestSuite named: 'ParseStringsUsingWordAlignment'. suite addTest: (OSCParserTest3 selector: #testWordAlignment). ^ suite ! ! !OSCParserTest3 methodsFor: 'setup' stamp: 'StephaneDucasse 9/29/2012 23:07'! setUpParsedMessages parsedMessages := Dictionary new. streams keysAndValuesDo: [ :key :value | parsedMessages at: key put: (OSCParser parse: value ascii) ]. ! ! !OSCParserTest3 methodsFor: 'setup' stamp: 'StephaneDucasse 9/29/2012 23:07'! setUpStartingNumberArray | headerString typeMarker sizeOfPad nulls headerArray | headerString := 'Head'. typeMarker := ',s'. sizeOfPad := 4 - typeMarker size. nulls := Array new: sizeOfPad withAll: 0. headerArray := (headerString , typeMarker ) asArray. startingNumberArray := ( headerArray , nulls ) . ! ! !OSCParserTest3 methodsFor: 'setup' stamp: 'StephaneDucasse 9/29/2012 23:08'! setUpEndingNumberArray endingNumberArray := string asArray collect: [ :each | each asInteger ] ! ! !OSCParserTest3 methodsFor: 'setup' stamp: 'SimonHolland 9/9/2007 12:34'! setUp self setUpString. self setUpStartingNumberArray. self setUpEndingNumberArray. self setUpNumberArrays. self setUpStreams. self setUpParsedMessages.! ! !OSCParserTest3 methodsFor: 'setup' stamp: 'StephaneDucasse 9/29/2012 23:08'! setUpNumberArrays | endArray | numberArrays := Dictionary new. (1 to: 4) keysAndValuesDo: [:key :value | endArray := endingNumberArray copyFrom: key to: endingNumberArray size. numberArrays at: key put: (startingNumberArray , endArray) ]. ! ! !OSCParserTest3 methodsFor: 'setup' stamp: 'SimonHolland 9/9/2007 10:44'! setUpStreams streams := Dictionary new. numberArrays keysAndValuesDo: [ :key :value | streams at: key put: (self streamFromArray: value) ]. ! ! !OSCParserTest3 methodsFor: 'setup' stamp: 'StephaneDucasse 9/29/2012 23:07'! setUpString string := 'Reaktivision is highly Groovy 0123456789' ! ! !OSCParserTest3 methodsFor: 'tests' stamp: 'StephaneDucasse 9/29/2012 23:06'! testWordAlignment parsedMessages keysAndValuesDo: [ :key :value | "Transcript cr; show: ' Actual - ' , ((parsedMessages at:key) first second); cr. Transcript cr; show: ' Should be - ', ( string copyFrom: key to: string size ); cr." self assert: ((parsedMessages at: key) first second ) = ( string copyFrom: key to: string size ) ]. ! ! !OSCParserTest3 methodsFor: 'converting' stamp: 'gk 5/18/2021 18:51'! streamFromArray: anArray | stream | stream:= (OSCStream on: (String new: 2048)) binary; yourself. anArray do: [:each | stream nextPut: each asInteger]. stream reset. ^ stream binary ! ! TestCase subclass: #OSCServerTest instanceVariableNames: '' classVariableNames: '' package: 'OSC-Tests'! !OSCServerTest methodsFor: 'tests' stamp: 'StephaneDucasse 9/29/2012 23:08'! testSendAndReceive | server | server := OSCServer listenOnPort: 5432. [OSCMessage example1 sendTo: NetNameResolver localHostAddress port: 5432. (Delay forDuration: (Duration milliSeconds: 30)) wait. self assert: server hasMessage. self assert: server nextMessage = #('/example1' 100 )] ensure: [server terminate]! ! TestCase subclass: #OSCSmallIntegerTest instanceVariableNames: '' classVariableNames: '' package: 'OSC-Tests'! !OSCSmallIntegerTest methodsFor: 'tests' stamp: 'gk 5/18/2021 18:51'! testPrintOnOSCStream "self debug: #testPrintOnOSCStream" | aByteArray aStream | aStream := (OSCStream on: '') binary. aByteArray := ((OSCStream on: '') binary; nextPut: 0; nextPut: 0; nextPut: 4; nextPut: 100; contents). 1124 printOnOSCStream: aStream. self assert: ( aStream contents = aByteArray)! ! TestCase subclass: #OSCStringTest instanceVariableNames: '' classVariableNames: '' package: 'OSC-Tests'! !OSCStringTest methodsFor: 'tests' stamp: 'gk 5/18/2021 18:51'! testPrintOnOSCStream "self debug: #testPrintOnOSCStream" | aString aStream | aStream := (OSCStream on: '') binary. aString := ((WriteStream on: '') nextPutAll: 'abc'; nextPut: (Character value: 0); contents). 'abc' printOnOSCStream: aStream. self assert: (aStream ascii contents = aString). aStream := (OSCStream on: '') binary. aString := ((WriteStream on: '') nextPutAll: 'abcd'; nextPutAll: (Array new: 4 withAll: (Character value: 0)); contents). 'abcd' printOnOSCStream: aStream. self assert: (aStream ascii contents = aString)! ! 'From Pharo9.0.0 of 6 May 2021 [Build information: Pharo-9.0.0+build.1393.sha.9d0b61644429ec81e56888d037d2772f49e627e0 (64 Bit)] on 21 May 2021 at 1:33:16.674038 pm'! !SequenceableCollection methodsFor: '*OSC-printing' stamp: 'mga 6/27/2000 15:30'! printOnOSCStream: aStream self do: [:each | each printOnOSCStream: aStream]! ! 'From Pharo9.0.0 of 6 May 2021 [Build information: Pharo-9.0.0+build.1393.sha.9d0b61644429ec81e56888d037d2772f49e627e0 (64 Bit)] on 21 May 2021 at 1:33:16.675078 pm'! !SequenceableCollection methodsFor: '*OSC-printing' stamp: 'mga 6/27/2000 15:31'! printTypeOnOSCStream: aStream aStream nextPut: $[. self do: [:each | each printTypeOnOSCStream: aStream]. aStream nextPut: $]! ! 'From Pharo9.0.0 of 6 May 2021 [Build information: Pharo-9.0.0+build.1393.sha.9d0b61644429ec81e56888d037d2772f49e627e0 (64 Bit)] on 21 May 2021 at 1:33:16.675794 pm'! !Boolean methodsFor: '*OSC-printing' stamp: 'mga 2/28/2005 17:16'! printOnOSCStream: aStream ^self! ! 'From Pharo9.0.0 of 6 May 2021 [Build information: Pharo-9.0.0+build.1393.sha.9d0b61644429ec81e56888d037d2772f49e627e0 (64 Bit)] on 21 May 2021 at 1:33:16.676442 pm'! !Symbol methodsFor: '*OSC-printing' stamp: 'mga 6/27/2000 15:23'! printTypeOnOSCStream: aStream aStream nextPut: $s! ! 'From Pharo9.0.0 of 6 May 2021 [Build information: Pharo-9.0.0+build.1393.sha.9d0b61644429ec81e56888d037d2772f49e627e0 (64 Bit)] on 21 May 2021 at 1:33:16.676882 pm'! !UndefinedObject methodsFor: '*OSC-printing' stamp: 'mga 6/27/2000 15:19'! printOnOSCStream: aStream ^self! ! 'From Pharo9.0.0 of 6 May 2021 [Build information: Pharo-9.0.0+build.1393.sha.9d0b61644429ec81e56888d037d2772f49e627e0 (64 Bit)] on 21 May 2021 at 1:33:16.677342 pm'! !UndefinedObject methodsFor: '*OSC-printing' stamp: 'mga 6/27/2000 15:18'! printTypeOnOSCStream: aStream aStream nextPut: $N ! ! 'From Pharo9.0.0 of 6 May 2021 [Build information: Pharo-9.0.0+build.1393.sha.9d0b61644429ec81e56888d037d2772f49e627e0 (64 Bit)] on 21 May 2021 at 1:33:16.677784 pm'! !String methodsFor: '*OSC-printing' stamp: 'mga 3/16/2005 09:40'! printOnOSCStream: aStream self isEmpty ifTrue: [^self]. aStream nextPutAll: self asByteArray. (4 - (self size \\ 4)) timesRepeat: [aStream nextPut: 0] ! ! 'From Pharo9.0.0 of 6 May 2021 [Build information: Pharo-9.0.0+build.1393.sha.9d0b61644429ec81e56888d037d2772f49e627e0 (64 Bit)] on 21 May 2021 at 1:33:16.678179 pm'! !String methodsFor: '*OSC-printing' stamp: 'mga 3/2/2005 10:49'! printTypeOnOSCStream: aStream aStream nextPut: $s ! ! 'From Pharo9.0.0 of 6 May 2021 [Build information: Pharo-9.0.0+build.1393.sha.9d0b61644429ec81e56888d037d2772f49e627e0 (64 Bit)] on 21 May 2021 at 1:33:16.678551 pm'! !SmallInteger methodsFor: '*OSC-printing' stamp: 'mga 3/2/2005 10:47'! printOnOSCStream: aStream aStream nextInt32Put: self! ! 'From Pharo9.0.0 of 6 May 2021 [Build information: Pharo-9.0.0+build.1393.sha.9d0b61644429ec81e56888d037d2772f49e627e0 (64 Bit)] on 21 May 2021 at 1:33:16.678961 pm'! !SmallInteger methodsFor: '*OSC-printing' stamp: 'mga 6/25/2000 10:12'! printTypeOnOSCStream: aStream aStream nextPut: $i! ! 'From Pharo9.0.0 of 6 May 2021 [Build information: Pharo-9.0.0+build.1393.sha.9d0b61644429ec81e56888d037d2772f49e627e0 (64 Bit)] on 21 May 2021 at 1:33:16.679355 pm'! !Float methodsFor: '*OSC-printing' stamp: 'mga 6/23/2000 15:43'! printOnOSCStream:aStream aStream nextNumber: 4 put: self asIEEE32BitWord! ! 'From Pharo9.0.0 of 6 May 2021 [Build information: Pharo-9.0.0+build.1393.sha.9d0b61644429ec81e56888d037d2772f49e627e0 (64 Bit)] on 21 May 2021 at 1:33:16.67975 pm'! !Float methodsFor: '*OSC-printing' stamp: 'mga 6/25/2000 11:10'! printTypeOnOSCStream: aStream aStream nextPut: $f! ! 'From Pharo9.0.0 of 6 May 2021 [Build information: Pharo-9.0.0+build.1393.sha.9d0b61644429ec81e56888d037d2772f49e627e0 (64 Bit)] on 21 May 2021 at 1:33:16.680114 pm'! !True methodsFor: '*OSC-printing' stamp: 'mga 6/27/2000 15:20'! printTypeOnOSCStream: aStream aStream nextPut: $T! ! 'From Pharo9.0.0 of 6 May 2021 [Build information: Pharo-9.0.0+build.1393.sha.9d0b61644429ec81e56888d037d2772f49e627e0 (64 Bit)] on 21 May 2021 at 1:33:16.68047 pm'! !False methodsFor: '*OSC-printing' stamp: 'mga 6/27/2000 15:21'! printTypeOnOSCStream: aStream aStream nextPut: $F! !