Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

hosc-0.21 support #1105

Merged
merged 5 commits into from
Jan 18, 2025
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
30 changes: 24 additions & 6 deletions flake.lock

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

6 changes: 6 additions & 0 deletions flake.nix
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,11 @@
inputs = {
utils.url = "github:numtide/flake-utils";
nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable";
# Manually include `hosc` at the `v0.21.0`
hosc = {
flake = false;
url = "github:rd--/hosc?rev=43bb2d07ff8d65cf9e51d1f5f96d0e6ffd6fe8fa";
};
};

outputs = inputs: let
Expand All @@ -38,6 +43,7 @@

mkPackages = pkgs: let
project = pkgs.haskellPackages.extend (pkgs.haskell.lib.compose.packageSourceOverrides {
hosc = inputs.hosc; # Manually added as `hosc` 0.21 is not yet in nixpkgs.
tidal = ./.;
tidal-link = ./tidal-link;
tidal-listener = ./tidal-listener;
Expand Down
2 changes: 1 addition & 1 deletion stack.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@ packages:
- 'tidal-link'

extra-deps:
- hosc-0.20
- hosc-0.21
- haskellish-0.3.2.2


2 changes: 1 addition & 1 deletion tidal-link/tidal-link.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -33,7 +33,7 @@ library

build-depends:
base >=4.8 && <5,
hosc,
hosc >= 0.21 && <0.22,
mtl,
stm

Expand Down
77 changes: 40 additions & 37 deletions tidal-listener/src/Sound/Tidal/Listener.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,48 +6,51 @@ import qualified Sound.Tidal.Context as T
import Sound.Tidal.Hint
import Sound.Tidal.Listener.Config
import Sound.Osc.Fd as O
import Sound.Osc.Transport.Fd.Udp as UDP
import Control.Concurrent
import qualified Network.Socket as N


data State = State {sIn :: MVar InterpreterMessage,
sOut :: MVar InterpreterResponse,
sLocal :: Udp,
sRemote :: N.SockAddr,
sStream :: T.Stream
}
data State = State
{ sIn :: MVar InterpreterMessage
, sOut :: MVar InterpreterResponse
, sLocal :: Udp
, sRemote :: N.SockAddr
, sStream :: T.Stream
}


-- | Start Haskell interpreter, with input and output mutable variables to
-- communicate with it
listenWithConfig :: Config -> IO ()
listenWithConfig Config{..} = do
putStrLn $ "Starting Tidal Listener " ++ if noGHC then "without installed GHC" else "with installed GHC"
putStrLn $ "Listening for OSC commands on port " ++ show listenPort
putStrLn $ "Sending replies to port " ++ show replyPort
putStrLn $ "Starting Tidal Listener " ++ if noGHC then "without installed GHC" else "with installed GHC"
putStrLn $ "Listening for OSC commands on port " ++ show listenPort
putStrLn $ "Sending replies to port " ++ show replyPort

--start the stream
stream <- startListenerStream replyPort dirtPort
--start the stream
stream <- startListenerStream replyPort dirtPort

mIn <- newEmptyMVar
mOut <- newEmptyMVar
mIn <- newEmptyMVar
mOut <- newEmptyMVar

putStrLn "Starting tidal interpreter.. "
_ <- forkIO $ startHintJob True stream mIn mOut
putStrLn "Starting tidal interpreter.. "
_ <- forkIO $ startHintJob True stream mIn mOut

(remote_addr:_) <- N.getAddrInfo Nothing (Just "127.0.0.1") Nothing
local <- udpServer "127.0.0.1" listenPort
(remote_addr:_) <- N.getAddrInfo Nothing (Just "127.0.0.1") Nothing
let iOlocal = udpServer "127.0.0.1" listenPort
local <- iOlocal

let (N.SockAddrInet _ a) = N.addrAddress remote_addr
remote = N.SockAddrInet (fromIntegral replyPort) a
st = State mIn mOut local remote stream
loop st
where
loop st =
do -- wait for, read and act on OSC message
m <- recvMessage (sLocal st)
st' <- act st m
loop st'

let (N.SockAddrInet _ a) = N.addrAddress remote_addr
remote = N.SockAddrInet (fromIntegral replyPort) a
st = State mIn mOut local remote stream
loop st
where
loop st = do
m <- O.recvMessage (sLocal st)
st' <- act st m
loop st'


act :: State -> Maybe O.Message -> IO State
Expand All @@ -59,9 +62,9 @@ act st (Just (Message "/eval" [AsciiString statement])) =
do putMVar (sIn st) (MStat $ ascii_to_string statement)
r <- takeMVar (sOut st)
case r of
RStat (Just x) -> O.sendTo (sLocal st) (O.p_message "/eval/value" [string x]) (sRemote st)
RStat Nothing -> O.sendTo (sLocal st) (O.p_message "/eval/ok" []) (sRemote st)
RError e -> O.sendTo (sLocal st) (O.p_message "/eval/error" [string e]) (sRemote st)
RStat (Just x) -> UDP.sendTo (sLocal st) (O.p_message "/eval/value" [string x]) (sRemote st)
RStat Nothing -> UDP.sendTo (sLocal st) (O.p_message "/eval/ok" []) (sRemote st)
RError e -> UDP.sendTo (sLocal st) (O.p_message "/eval/error" [string e]) (sRemote st)
_ -> return ()
return st

Expand All @@ -70,30 +73,30 @@ act st (Just (Message "/type" [AsciiString expression])) =
do putMVar (sIn st) (MType $ ascii_to_string expression)
r <- takeMVar (sOut st)
case r of
RType t -> O.sendTo (sLocal st) (O.p_message "/type/ok" [string t]) (sRemote st)
RError e -> O.sendTo (sLocal st) (O.p_message "/type/error" [string e]) (sRemote st)
RType t -> UDP.sendTo (sLocal st) (O.p_message "/type/ok" [string t]) (sRemote st)
RError e -> UDP.sendTo (sLocal st) (O.p_message "/type/error" [string e]) (sRemote st)
_ -> return ()
return st

act st (Just (Message "/load" [AsciiString path])) =
do putMVar (sIn st) (MLoad $ ascii_to_string path)
r <- takeMVar (sOut st)
case r of
RStat (Just x) -> O.sendTo (sLocal st) (O.p_message "/load/value" [string x]) (sRemote st) --cannot happen
RStat Nothing -> O.sendTo (sLocal st) (O.p_message "/load/ok" []) (sRemote st)
RError e -> O.sendTo (sLocal st) (O.p_message "/load/error" [string e]) (sRemote st)
RStat (Just x) -> UDP.sendTo (sLocal st) (O.p_message "/load/value" [string x]) (sRemote st) --cannot happen
RStat Nothing -> UDP.sendTo (sLocal st) (O.p_message "/load/ok" []) (sRemote st)
RError e -> UDP.sendTo (sLocal st) (O.p_message "/load/error" [string e]) (sRemote st)
_ -> return ()
return st

-- test if the listener is responsive
act st (Just (Message "/ping" [])) =
do O.sendTo (sLocal st) (O.p_message "/pong" []) (sRemote st)
do UDP.sendTo (sLocal st) (O.p_message "/pong" []) (sRemote st)
return st

-- get the current cps of the running stream
act st (Just (Message "/cps" [])) =
do cps <- streamGetCPS (sStream st)
O.sendTo (sLocal st) (O.p_message "/cps" [float cps]) (sRemote st)
UDP.sendTo (sLocal st) (O.p_message "/cps" [float cps]) (sRemote st)
return st

act st Nothing = do putStrLn "Not a message?"
Expand Down
5 changes: 2 additions & 3 deletions tidal-listener/tidal-listener.cabal
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
cabal-version: >=1.10

cabal-version: 2.0
name: tidal-listener
version: 0.1.0.0
-- synopsis:
Expand Down Expand Up @@ -27,7 +26,7 @@ library
deepseq,
optparse-applicative,
tidal >= 1.10 && < 1.11,
hosc >= 0.20 && < 0.21,
hosc >= 0.21 && < 0.22,
hint,
network
default-language: Haskell2010
Expand Down
4 changes: 2 additions & 2 deletions tidal.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -61,7 +61,7 @@ library
base >=4.8 && <5
, containers < 0.8
, colour < 2.4
, hosc >= 0.20 && < 0.21
, hosc >= 0.21 && < 0.22
, text < 2.2
, parsec >= 3.1.12 && < 3.2
, network < 3.3
Expand Down Expand Up @@ -96,7 +96,7 @@ test-suite tests
build-depends:
base ==4.*
, microspec >= 0.2.0.1
, hosc >= 0.20 && < 0.21
, hosc >= 0.21 && < 0.22
, containers
, parsec
, tidal
Expand Down
Loading