diff --git a/README b/README --- a/README +++ b/README @@ -1,11 +1,50 @@ hosc-utils ---------- -utilities related to [hosc][hosc] +utilities related to [hosc][hosc] and [hosc-json][hosc-json]. to build type: + $ cd hs; make prefix=~/opt all install + +`hosc-json-cat` reads [JSON][json] representations of [OSC][osc] +packets from `stdin`, one per line, and forwards them in binary form +to a UDP port (ie. [scsynth][sc3]). + + $ echo '["/c_set",0,440]' | hosc-json-cat -h 127.0.0.1 -p 57110 + +`hosc-json-cgi` reads a JSON OSC packet at the query parameter `j` and +forwards over UDP. + + http://localhost/hosc-json-cgi?p=57110&j=["/c_set",0,440,1,0.1] + +`hosc-json-console` is a [readline][haskeline] variant of +`hosc-json-cat`, supporting history and line editing etc. It reads +JSON OSC packets from `stdin`, one per line, and forwards them over +UDP. (ie. `scsynth`). + +`hosc-json-nrt` reads an [SC3][sc3] non-realtime score, which is a +sequence of length prefixed OSC bundles, and prints the JSON +representation of each element to `stdout`. + + $ hosc-json-nrt ~/uc/see-hearer-clearer/osc/shc-C.osc | less + +`hosc-json-ws` is a [websocket][ws] server that forwards incoming JSON OSC +packets at a specified `ws:` port (`-w`) to a UDP port (`-p`). There +are test sources ([Chrome][chrome]\ 11.0.696.57) at: + +- [01.html](sw/hosc-utils/html/json-ws.01.html) - plain text +- [02.html](sw/hosc-utils/html/json-ws.02.html) - mouse co-ordinates +- [03.svg](sw/hosc-utils/svg/json-ws.03.svg) - UGen graph (drawing) +- [04.html](sw/hosc-utils/html/json-ws.04.html) - UGen graph (text) + [hosc]: http://rd.slavepianos.org/?t=hosc +[hosc-json]: http://rd.slavepianos.org/?t=hosc-json +[json]: http://json.org/ +[osc]: http://opensoundcontrol.org/ +[ws]: http://www.websocket.org/ +[haskeline]: http://hackage.haskell.org/package/haskeline +[chrome]: http://www.google.com/chrome +[sc3]: http://audiosynth.com/ -© [stefan kersten][sk], 2011, [gpl] +© rd, 2011-2013, [gpl] -[sk]: http://space.k-hornz.de/ [gpl]: http://gnu.org/copyleft/ diff --git a/benchmarks/Sound/OpenSoundControl/NFData.hs b/benchmarks/Sound/OpenSoundControl/NFData.hs deleted file mode 100644 --- a/benchmarks/Sound/OpenSoundControl/NFData.hs +++ /dev/null @@ -1,28 +0,0 @@ -module Sound.OpenSoundControl.NFData () where - -import Control.DeepSeq (NFData(..)) -import Sound.OpenSoundControl - -instance NFData Time where - rnf (UTCr x1) = rnf x1 `seq` () - rnf (NTPr x1) = rnf x1 `seq` () - rnf (NTPi x1) = rnf x1 `seq` () - -instance NFData Datum where - rnf (Int x1) = rnf x1 `seq` () - rnf (Float x1) = rnf x1 `seq` () - rnf (Double x1) = rnf x1 `seq` () - rnf (String x1) = rnf x1 `seq` () - rnf (Blob x1) = rnf x1 `seq` () - rnf (TimeStamp x1) = rnf x1 `seq` () - rnf (Midi x1) = rnf x1 `seq` () - -instance NFData Message where - rnf (Message x1 x2) = rnf x1 `seq` rnf x2 `seq` () - -instance NFData Bundle where - rnf (Bundle x1 x2) = rnf x1 `seq` rnf x2 `seq` () - -instance NFData Packet where - rnf (Packet_Message x1) = rnf x1 `seq` () - rnf (Packet_Bundle x1) = rnf x1 `seq` () diff --git a/benchmarks/benchmark.hs b/benchmarks/benchmark.hs deleted file mode 100644 --- a/benchmarks/benchmark.hs +++ /dev/null @@ -1,32 +0,0 @@ -import Criterion.Main - -import qualified Data.ByteString.Lazy as B -import Sound.OpenSoundControl -import Sound.OpenSoundControl.NFData () -import qualified Sound.OpenSoundControl.Coding.Decode.Binary as Binary -import qualified Sound.OpenSoundControl.Coding.Encode.Builder as Builder -import qualified Sound.OpenSoundControl.Coding.Decode.Base as Decode -import qualified Sound.OpenSoundControl.Coding.Encode.Base as Encode - -type EncodingFunc = Bundle -> B.ByteString -type DecodingFunc = B.ByteString -> Packet - -main :: IO () -main = - defaultMain [ - bgroup "encodeOSC" [ - bench "Encode" (nf (Encode.encodeBundle :: EncodingFunc) b) - , bench "Builder" (nf (Builder.encodeBundle :: EncodingFunc) b) - ] - , bgroup "decodeOSC" [ - bench "Decode" (nf (Decode.decodePacket :: DecodingFunc) p) - , bench "Binary" (nf (Binary.decodePacket :: DecodingFunc) p) - ] - ] - where - m = Message "/fooblah" [Float 42 - ,Int 16 - ,String "yeah" - ,Blob (B.pack [0..128])] - b = Bundle (NTPr pi) (replicate 12 m) - p = Encode.encodeBundle b diff --git a/hosc-utils.cabal b/hosc-utils.cabal --- a/hosc-utils.cabal +++ b/hosc-utils.cabal @@ -1,11 +1,11 @@ Name: hosc-utils -Version: 0.12 +Version: 0.14 Synopsis: Haskell Open Sound Control Utilities Description: hosc-utils License: GPL Category: Sound -Copyright: (c) Stefan Kersten and others, 2006-2012 -Author: Stefan Kersten +Copyright: (c) Rohan Drape and others, 2006-2013 +Author: Rohan Drape Maintainer: rd@slavepianos.org Stability: Experimental Homepage: http://rd.slavepianos.org/?t=hosc-utils @@ -14,33 +14,76 @@ Cabal-Version: >= 1.8 Data-Files: README -Executable hosc-utils-benchmark - Hs-Source-Dirs: benchmarks, . - Main-Is: benchmark.hs - Other-Modules: - Sound.OpenSoundControl.NFData - Build-Depends: - base == 4.* - , bytestring - , hosc == 0.12.* - , criterion - , deepseq - GHC-Options: -Wall -fno-warn-orphans -fwarn-tabs -rtsopts - GHC-Prof-Options: -Wall -fwarn-tabs -rtsopts -auto-all +executable hosc-json-cat + build-depends: base == 4.*, + bytestring, + hosc == 0.14, + hosc-json == 0.14, + json, + text, + transformers, + utf8-string + hs-source-dirs: hs + main-is: json-cat.hs + ghc-options: -Wall -fwarn-tabs -Test-Suite hosc-utils-test - Type: exitcode-stdio-1.0 - Hs-Source-Dirs: tests, . - Main-Is: test.hs - Other-Modules: - Sound.OpenSoundControl.Arbitrary - Build-Depends: - hosc == 0.12.* - , QuickCheck >= 2 - , test-framework >= 0.2 - , test-framework-quickcheck2 >= 0.2 - GHC-Options: -Wall -fno-warn-orphans -fwarn-tabs -rtsopts - GHC-Prof-Options: -Wall -fwarn-tabs -rtsopts -auto-all +executable hosc-json-cgi + build-depends: base == 4.*, + bytestring, + cgi, + hosc == 0.14, + hosc-json == 0.14, + json, + text, + transformers, + utf8-string, + www-minus + hs-source-dirs: hs + main-is: json-cgi.hs + ghc-options: -Wall -fwarn-tabs + +executable hosc-json-console + build-depends: base == 4.*, + bytestring, + haskeline, + hosc == 0.14, + hosc-json == 0.14, + json, + text, + transformers, + utf8-string + hs-source-dirs: hs + main-is: json-console.hs + ghc-options: -Wall -fwarn-tabs + +executable hosc-json-nrt + build-depends: base == 4.*, + bytestring, + hosc == 0.14, + hosc-json == 0.14, + hsc3 == 0.14, + json, + text, + transformers, + utf8-string + hs-source-dirs: hs + main-is: json-nrt.hs + ghc-options: -Wall -fwarn-tabs + +executable hosc-json-ws + build-depends: base == 4.*, + bytestring, + hosc == 0.14, + hosc-json == 0.14, + bytestring, + json, + text, + transformers, + utf8-string, + websockets + hs-source-dirs: hs + main-is: json-ws.hs + ghc-options: -Wall -fwarn-tabs Source-Repository head Type: darcs diff --git a/hs/json-cat.hs b/hs/json-cat.hs new file mode 100644 --- /dev/null +++ b/hs/json-cat.hs @@ -0,0 +1,9 @@ +import Control.Monad +import qualified Data.ByteString as B {- bytestring -} +import U + +go :: WithT -> IO () +go withT = B.getLine >>= proc_b withT + +main :: IO () +main = opt_arg >>= forever . go . with_t diff --git a/hs/json-cgi.hs b/hs/json-cgi.hs new file mode 100644 --- /dev/null +++ b/hs/json-cgi.hs @@ -0,0 +1,37 @@ +import Data.List {- base -} +import qualified Network.CGI as C {- cgi -} +import Sound.OSC.Type.JSON {- hosc-json -} +import Sound.OSC {- hosc -} +import qualified WWW.Minus.CGI as W {- www-minus -} + +import qualified U + +err :: Show a => a -> W.Result +err e = W.utf8_text_output ("json-cgi: error: " ++ show e) + +handle_json :: U.WithT -> Value -> W.Result +handle_json withT j = + case decode_packet j of + Just o -> do C.liftIO (withT (sendOSC o)) + W.utf8_text_output ("json-cgi: sent: " ++ show o) + _ -> err ("json_packet",j) + +dispatch_get :: W.Query -> W.Result +dispatch_get q = + let h = U.lookup_with_def "h" "127.0.0.1" q + p = read (U.lookup_with_def "p" "57110" q) + in case lookup "j" q of + Just s -> case decode_json_str s of + Just j -> let t = withTransport (openUDP h p) + in handle_json t j + _ -> err ("JSON.decode",s) + _ -> err ("GET",q) + +dispatch :: () -> W.Dispatch +dispatch () (m,_,q) = + case m of + "GET" -> dispatch_get q + _ -> err ("dispatch",m) + +main :: IO () +main = W.run_cgi () dispatch diff --git a/hs/json-console.hs b/hs/json-console.hs new file mode 100644 --- /dev/null +++ b/hs/json-console.hs @@ -0,0 +1,15 @@ +import Control.Monad.IO.Class {- transformers -} +import System.Console.Haskeline {- haskeline -} + +import U + +go :: WithT -> InputT IO () +go withT = do + r <- getInputLine "% " + case r of + Nothing -> return () + Just "quit" -> return () + Just s -> liftIO (proc_s withT s) >> go withT + +main :: IO () +main = opt_arg >>= runInputT defaultSettings . go . with_t diff --git a/hs/json-nrt.hs b/hs/json-nrt.hs new file mode 100644 --- /dev/null +++ b/hs/json-nrt.hs @@ -0,0 +1,17 @@ +import Control.Monad {- base -} +import Sound.OSC {- hosc -} +import Sound.OSC.Type.JSON {- hosc-json -} +import Sound.SC3 {- sc3 -} +import System.Environment {- base -} + +wr :: Bundle -> IO () +wr = putStrLn . encode_json_str . encode_bundle + +main :: IO () +main = do + a <- getArgs + case a of + [nrt] -> do r <- readNRT nrt + mapM_ wr (nrt_bundles r) + _ -> error "json-nrt nrt-file" + diff --git a/hs/json-ws.hs b/hs/json-ws.hs new file mode 100644 --- /dev/null +++ b/hs/json-ws.hs @@ -0,0 +1,45 @@ +import Control.Monad {- base -} +import qualified Network.WebSockets as W {- websockets -} + +import U + +go :: WithT -> W.WebSockets W.Hybi00 () +go withT = W.receiveData >>= proc_t withT + +json_ws :: WithT -> W.Request -> W.WebSockets W.Hybi00 () +json_ws withT rq = do + W.acceptRequest rq + forever (go withT) + +main :: IO () +main = do + Opt t h w <- opt_arg + W.runServer h w (json_ws t) + +{- +json-ws.00 + +import Sound.SC3 + +let {kin = in' 1 KR + ;o = sinOsc AR (kin 0) 0} +in audition (out 0 (pan2 o (kin 2) (kin 1))) + +json-ws.02 + +let {kin = in' 1 KR + ;f = kin 0 * 600 + 400 + ;a = kin 1 * 0.1} +in audition (out 0 (sinOsc AR f 0 * a)) + +json-ws.03 + +let {k0 = control KR "k0" 440 + ;k1 = control KR "k1" 0 + ;k2 = control KR "k2" 0.1 + ;k3 = control KR "k3" 0} +in audition (out k3 (sinOsc AR k0 k1 * k2)) + +withSC3 (send (n_set (-1) [("k0",660)])) +withSC3 (send (n_set (-1) [("k2",0.01)])) +-} diff --git a/tests/Sound/OpenSoundControl/Arbitrary.hs b/tests/Sound/OpenSoundControl/Arbitrary.hs deleted file mode 100644 --- a/tests/Sound/OpenSoundControl/Arbitrary.hs +++ /dev/null @@ -1,36 +0,0 @@ -module Sound.OpenSoundControl.Arbitrary () where - -import Control.Applicative -import qualified Data.ByteString.Lazy as B -import Sound.OpenSoundControl (Datum(..), OSC(..), Time(..), NTPi) -import Test.QuickCheck - -instance Arbitrary Time where - arbitrary = oneof [ - UTCr <$> realToFrac <$> (arbitrary :: Gen (NonNegative Double)) - , NTPr <$> realToFrac <$> (arbitrary :: Gen (NonNegative Double)) - , NTPi <$> fromIntegral <$> (arbitrary :: Gen (Positive NTPi)) - ] - -instance Arbitrary Datum where - arbitrary = oneof [ - Int <$> arbitrary - , Float <$> realToFrac <$> (arbitrary :: Gen Float) - , Double <$> arbitrary - , String <$> genString - , Blob <$> B.pack <$> resize 128 arbitrary - , TimeStamp <$> arbitrary - , Midi <$> arbitrary - ] - -genString :: Gen String -genString = resize 128 (listOf (arbitrary `suchThat` (/= '\0'))) - -genMessage :: Gen OSC -genMessage = Message <$> ("/"++) <$> genString <*> resize 32 (listOf1 arbitrary) - -instance Arbitrary OSC where - arbitrary = oneof [ - genMessage - , Bundle <$> arbitrary <*> resize 32 (listOf1 genMessage) - ] diff --git a/tests/test.hs b/tests/test.hs deleted file mode 100644 --- a/tests/test.hs +++ /dev/null @@ -1,23 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} - -import Sound.OpenSoundControl (OSC) -import Sound.OpenSoundControl.Arbitrary () -import qualified Sound.OpenSoundControl.OSC.Decode as Decode -import qualified Sound.OpenSoundControl.OSC.Encode as Encode -import qualified Sound.OpenSoundControl.OSC.Binary as Binary -import qualified Sound.OpenSoundControl.OSC.Builder as Builder -import Test.Framework (Test, defaultMain) -import Test.Framework.Providers.QuickCheck2 (testProperty) - -tests :: [Test] -tests = - [ testProperty "encodeOSC (Builder)" $ \(osc :: OSC) -> - Builder.encodeOSC osc == Encode.encodeOSC osc - , testProperty "encodeOSC/decodeOSC" $ \(osc :: OSC) -> - Decode.decodeOSC (Encode.encodeOSC osc) == osc - , testProperty "decodeOSC (Get)" $ \(osc :: OSC) -> - Binary.decodeOSC (Encode.encodeOSC osc) == osc - ] - -main :: IO () -main = defaultMain tests