tidal 0.2.2 → 0.2.2.6
raw patch · 9 files changed
+353/−38 lines, 9 files
Files
- Dirt.hs +2/−2
- Pattern.hs +21/−27
- Strategies.hs +4/−0
- Stream.hs +4/−4
- Tempo.hs +17/−1
- doc/tidal.pandoc +6/−2
- doc/tidal.pdf binary
- tidal.cabal +2/−2
- tidal.el +297/−0
Dirt.hs view
@@ -46,7 +46,7 @@ timestamp = True } -+dirtstart name = start "127.0.0.1" 7771 dirt dirtstream name = stream "127.0.0.1" 7771 dirt kstream name = stream "127.0.0.1" 7771 kriole @@ -119,4 +119,4 @@ metronome = slow 2 $ sound (p "[odx, [hh]*8]") interlace :: OscPattern -> OscPattern -> OscPattern-interlace a b = weave 16 (shape sinewave1) [a, b]+interlace a b = weave 16 (shape $ ((* 0.9) <$> sinewave1)) [a, b]
Pattern.hs view
@@ -47,18 +47,7 @@ ) (arc p a) )-{-- p >>= f = - Pattern (\a -> concatMap - (\(a', x) -> - mapFsts (fromJust . (subArc a)) $- filter - (isIn a . eventStart)- (arc (f x) a')- )- (arc p a)- )--}+ atom :: a -> Pattern a atom x = Pattern f where f (s, e) = map @@ -94,24 +83,24 @@ append :: Pattern a -> Pattern a -> Pattern a append a b = cat [a,b] -slowcat ps = Pattern $ \a -> concatMap f (arcCycles a)+slowcat' ps = Pattern $ \a -> concatMap f (arcCycles a) where l = length ps f (s,e) = arc p (s,e) where p = ps !! n n = (floor s) `mod` l-{--slowcat :: [Pattern a] -> Pattern a-slowcat [] = silence++-- Concatenates so that the first loop of each pattern is played in+-- turn, second loop of each pattern, and so on..+ slowcat ps = Pattern $ \a -> concatMap f (arcCycles a) where l = length ps- f (s,e) = mapFsts arcF $ arc p (s', s' + (e - s))+ f (s,e) = arc (mapResultTime (+offset) p) (s',e') where p = ps !! n- n = (floor s) `mod` l- cyc = (floor s) - n- s' = fromIntegral (cyc `div` l) + cyclePos s- arcF (s'',e'') = (s''', s''' + (e'' - s''))- where s''' = (fromIntegral $ cyc + n) + (cyclePos s'')--}+ r = (floor s) :: Int+ n = (r `mod` l) :: Int+ offset = (fromIntegral $ r - ((r - n) `div` l)) :: Time+ (s', e') = (s-offset, e-offset)+ listToPat :: [a] -> Pattern a listToPat = cat . map atom @@ -148,6 +137,10 @@ where apply a | test (floor $ fst a) = (arc $ f p) a | otherwise = (arc p) a +every :: Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a+every 0 f p = p+every n f p = when ((== 0) . (`mod` n)) f p+ palindrome :: Pattern a -> Pattern a palindrome p = slowcat [p, rev p] @@ -187,10 +180,6 @@ seqToRelOnsets :: Arc -> Pattern a -> [(Double, a)] seqToRelOnsets (s, e) p = mapFsts (fromRational . (/ (e-s)) . (subtract s) . fst) $ arc (filterOffsets p) (s, e) -every :: Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a-every 0 _ p = p-every n f p = slow (fromIntegral n %1) $ cat $ (take (n-1) $ repeat p) ++ [f p]- segment :: Pattern a -> Pattern [a] segment p = Pattern $ \r -> groupByTime (segment' (arc p r)) @@ -210,3 +199,8 @@ groupByTime :: [Event a] -> [Event [a]] groupByTime es = map mrg $ groupBy ((==) `on` fst) $ sortBy (compare `on` fst) es where mrg es@((a, _):_) = (a, map snd es)++ifp :: (Int -> Bool) -> (Pattern a -> Pattern a) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a+ifp test f1 f2 p = Pattern $ \a -> concatMap apply (arcCycles a)+ where apply a | test (floor $ fst a) = (arc $ f1 p) a+ | otherwise = (arc $ f2 p) a
Strategies.hs view
@@ -25,7 +25,11 @@ samples :: Applicative f => f String -> f Int -> f String samples p p' = pick <$> p <*> p' +spread :: (a -> t -> Pattern b) -> [a] -> t -> Pattern b spread f xs p = cat $ map (\x -> f x p) xs++slowspread :: (a -> t -> Pattern b) -> [a] -> t -> Pattern b+slowspread f xs p = slow (fromIntegral $ length $ xs) $ spread f xs p spread' :: (a -> Pattern b -> Pattern c) -> Pattern a -> Pattern b -> Pattern c spread' f timepat pat =
Stream.hs view
@@ -66,11 +66,11 @@ tpb = 1 -toMessage :: OscShape -> Tempo -> Int -> (Double, OscMap) -> Maybe Bundle+toMessage :: OscShape -> Tempo -> Int -> (Double, OscMap) -> Maybe Message toMessage s change ticks (o, m) = do m' <- applyShape' s m let beat = fromIntegral ticks / fromIntegral tpb- latency = 0.01+ latency = 0.04 logicalNow = (logicalTime change beat) beat' = (fromIntegral ticks + 1) / fromIntegral tpb logicalPeriod = (logicalTime change (beat + 1)) - logicalNow@@ -80,8 +80,8 @@ usec = floor $ 1000000 * (logicalOnset - (fromIntegral sec)) oscdata = catMaybes $ mapMaybe (\x -> Map.lookup x m') (params s) oscdata' = ((Int sec):(Int usec):oscdata)- osc | timestamp s = Bundle (immediately) [Message (path s) oscdata']- | otherwise = Bundle (immediately) [Message (path s) oscdata]+ osc | timestamp s = Message (path s) oscdata'+ | otherwise = Message (path s) oscdata return osc
Tempo.hs view
@@ -40,7 +40,20 @@ timeDelta = beatDelta / (bps t) changeT = realToFrac $ utcTimeToPOSIXSeconds $ at t +tempoMVar :: IO (MVar (Tempo))+tempoMVar = do now <- getCurrentTime+ mv <- newMVar (Tempo now 0 1)+ forkIO $ clocked $ f mv+ return mv+ where f mv change _ = do swapMVar mv change+ return () +beatNow :: Tempo -> IO (Double)+beatNow t = do now <- getCurrentTime+ let delta = realToFrac $ diffUTCTime now (at t)+ let beatDelta = bps t * delta + return $ beat t + beatDelta+ clientApp :: MVar Tempo -> MVar Double -> WS.WebSockets WS.Hybi10 () clientApp mTempo mBps = do sink <- WS.getSink@@ -77,6 +90,10 @@ forkIO $ connectClient clockip mTempo mBps return (mTempo, mBps) +bpsSetter :: IO (Double -> IO ())+bpsSetter = do (_, mBps) <- runClient + return $ (\b -> putMVar mBps b)+ clocked :: (Tempo -> Int -> IO ()) -> IO () clocked callback = do (mTempo, mBps) <- runClient@@ -98,7 +115,6 @@ threadDelay $ floor (delay * 1000000) callback t b loop mTempo $ b + 1- updateTempo :: MVar Tempo -> Maybe Double -> IO () updateTempo mt Nothing = return ()
doc/tidal.pandoc view
@@ -43,6 +43,11 @@ ./dirt & +If you have problems with jack, try enabling realtime audio, and+adjusting the settings by installing and using the "qjackctl"+software. Some more info is here: <https://help.ubuntu.com/community/HowToJACKConfiguration>++ ### Tidal @@ -74,8 +79,7 @@ (add-to-list 'load-path "~/projects/tidal") (require 'tidal) -If tidal.el did not come with this document, you can grab it here:- <https://raw.github.com/yaxu/Tidal/master/tidal.el>+If tidal.el did not come with this document, you can grab it here: <https://raw.github.com/yaxu/Tidal/master/tidal.el> ### Testing, testing...
doc/tidal.pdf view
binary file changed (43958 → 44740 bytes)
tidal.cabal view
@@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version: 0.2.2+Version: 0.2.2.6 -- A short (one-line) description of the package. Synopsis: Pattern language for improvised music@@ -40,7 +40,7 @@ -- Extra files to be distributed with the package, such as examples or -- a README.-Extra-source-files: README.md doc/tidal.pandoc doc/tidal.pdf+Extra-source-files: README.md tidal.el doc/tidal.pandoc doc/tidal.pdf -- Constraint on the version of Cabal needed to build this package. Cabal-version: >=1.4
+ tidal.el view
@@ -0,0 +1,297 @@+;; tidal.el - (c) alex@slab.org, 20012, based heavily on...+;; hsc3.el - (c) rohan drape, 2006-2008++;; notes from hsc3:+;; This mode is implemented as a derivation of `haskell' mode,+;; indentation and font locking is courtesy that mode. The+;; inter-process communication is courtesy `comint'. The symbol at+;; point acquisition is courtesy `thingatpt'. The directory search+;; facilities are courtesy `find-lisp'.++(require 'scheme)+(require 'comint)+(require 'thingatpt)+(require 'find-lisp)+(require 'pulse)++(defvar tidal-buffer+ "*tidal*"+ "*The name of the tidal process buffer (default=*tidal*).")++(defvar tidal-interpreter+ "ghci"+ "*The haskell interpeter to use (default=ghci).")++(defvar tidal-interpreter-arguments+ (list "-XOverloadedStrings"+ )+ "*Arguments to the haskell interpreter (default=none).")++(defvar tidal-run-control+ "~/.tidal.hs"+ "*Run control file (default=~/.tidal.hs)")++(defvar tidal-modules+ (list "import Control.Concurrent"+ "import Control.Monad"+ "import Data.List"+ "import Control.Applicative"+ "import Parse"+ "import Pattern"+ "import Stream"+ "import Dirt"+ "import Strategies"+ "import Tempo"+ )+ "*List of modules (possibly qualified) to bring into interpreter context.")++(defvar tidal-literate-p+ t+ "*Flag to indicate if we are in literate mode (default=t).")++(make-variable-buffer-local 'tidal-literate-p)++(defun tidal-unlit (s)+ "Remove bird literate marks"+ (replace-regexp-in-string "^> " "" s))++(defun tidal-intersperse (e l)+ (if (null l)+ '()+ (cons e (cons (car l) (tidal-intersperse e (cdr l))))))++(defun tidal-write-default-run-control ()+ "Write default run control file if no file exists."+ (if (not (file-exists-p tidal-run-control))+ (with-temp-file+ tidal-run-control+ (mapc+ (lambda (s)+ (insert (concat s "\n")))+ tidal-modules))))++(defun tidal-start-haskell ()+ "Start haskell."+ (interactive)+ (if (comint-check-proc tidal-buffer)+ (error "A tidal process is already running")+ (apply+ 'make-comint+ "tidal"+ tidal-interpreter+ nil+ tidal-interpreter-arguments)+ (tidal-see-output))+ (tidal-write-default-run-control)+ (tidal-send-string (concat ":l " tidal-run-control))+ (tidal-send-string ":set prompt \"tidal> \"")+ (tidal-send-string "d1 <- dirtstream \"d1\"")+ (tidal-send-string "d2 <- dirtstream \"d2\"")+ (tidal-send-string "d3 <- dirtstream \"d3\"")+ (tidal-send-string "d4 <- dirtstream \"d4\"")+ (tidal-send-string "d5 <- dirtstream \"d5\"")+ (tidal-send-string "d6 <- dirtstream \"d6\"")+ (tidal-send-string "d7 <- dirtstream \"d7\"")+ (tidal-send-string "d8 <- dirtstream \"d8\"")+ (tidal-send-string "d9 <- dirtstream \"d9\"")+ (tidal-send-string "bps <- bpsSetter")+ (tidal-send-string "let hush = mapM_ ($ silence) [d1,d2,d3,d4,d5,d6,d7,d8,d9]")+)++(defun tidal-see-output ()+ "Show haskell output."+ (interactive)+ (when (comint-check-proc tidal-buffer)+ (delete-other-windows)+ (split-window-vertically)+ (with-current-buffer tidal-buffer+ (let ((window (display-buffer (current-buffer))))+ (goto-char (point-max))+ (save-selected-window+ (set-window-point window (point-max)))))))++(defun tidal-quit-haskell ()+ "Quit haskell."+ (interactive)+ (kill-buffer tidal-buffer)+ (delete-other-windows))++(defun tidal-help ()+ "Lookup up the name at point in the Help files."+ (interactive)+ (mapc (lambda (filename)+ (find-file-other-window filename))+ (find-lisp-find-files tidal-help-directory+ (concat "^"+ (thing-at-point 'symbol)+ "\\.help\\.lhs"))))++(defun chunk-string (n s)+ "Split a string into chunks of 'n' characters."+ (let* ((l (length s))+ (m (min l n))+ (c (substring s 0 m)))+ (if (<= l n)+ (list c)+ (cons c (chunk-string n (substring s n))))))++(defun tidal-send-string (s)+ (if (comint-check-proc tidal-buffer)+ (let ((cs (chunk-string 64 (concat s "\n"))))+ (mapcar (lambda (c) (comint-send-string tidal-buffer c)) cs))+ (error "no tidal process running?")))++(defun tidal-transform-and-store (f s)+ "Transform example text into compilable form."+ (with-temp-file f+ (mapc (lambda (module)+ (insert (concat module "\n")))+ tidal-modules)+ (insert "main = do\n")+ (insert (if tidal-literate-p (tidal-unlit s) s))))++(defun tidal-run-line ()+ "Send the current line to the interpreter."+ (interactive)+ (let* ((s (buffer-substring (line-beginning-position)+ (line-end-position)))+ (s* (if tidal-literate-p+ (tidal-unlit s)+ s)))+ (tidal-send-string s*))+ (pulse-momentary-highlight-one-line (point))+ (next-line)+ )++(defun tidal-run-multiple-lines ()+ "Send the current region to the interpreter as a single line."+ (interactive)+ (save-excursion+ (mark-paragraph)+ (let* ((s (buffer-substring-no-properties (region-beginning)+ (region-end)))+ (s* (if tidal-literate-p+ (tidal-unlit s)+ s)))+ (tidal-send-string ":{")+ (tidal-send-string s*)+ (tidal-send-string ":}")+ (mark-paragraph)+ (pulse-momentary-highlight-region (mark) (point))+ )+ ;(tidal-send-string (replace-regexp-in-string "\n" " " s*))+ )+ )++(defun tidal-run-region ()+ "Place the region in a do block and compile."+ (interactive)+ (tidal-transform-and-store+ "/tmp/tidal.hs"+ (buffer-substring-no-properties (region-beginning) (region-end)))+ (tidal-send-string ":load \"/tmp/tidal.hs\"")+ (tidal-send-string "main"))++(defun tidal-load-buffer ()+ "Load the current buffer."+ (interactive)+ (save-buffer)+ (tidal-send-string (format ":load \"%s\"" buffer-file-name)))++(defun tidal-run-main ()+ "Run current main."+ (interactive)+ (tidal-send-string "main"))++(defun tidal-interrupt-haskell ()+ (interactive)+ (if (comint-check-proc tidal-buffer)+ (with-current-buffer tidal-buffer+ (interrupt-process (get-buffer-process (current-buffer))))+ (error "no tidal process running?")))++(defvar tidal-mode-map nil+ "Tidal keymap.")++(defun tidal-mode-keybindings (map)+ "Haskell Tidal keybindings."+ (define-key map [?\C-c ?\C-s] 'tidal-start-haskell)+ (define-key map [?\C-c ?\C-v] 'tidal-see-output)+ (define-key map [?\C-c ?\C-q] 'tidal-quit-haskell)+ (define-key map [?\C-c ?\C-c] 'tidal-run-line)+ (define-key map [?\C-c ?\C-e] 'tidal-run-multiple-lines)+ (define-key map [?\C-c ?\C-r] 'tidal-run-region)+ (define-key map [?\C-c ?\C-l] 'tidal-load-buffer)+ (define-key map [?\C-c ?\C-i] 'tidal-interrupt-haskell)+ (define-key map [?\C-c ?\C-m] 'tidal-run-main)+ (define-key map [?\C-c ?\C-h] 'tidal-help))++(defun turn-on-tidal-keybindings ()+ "Haskell Tidal keybindings in the local map."+ (local-set-key [?\C-c ?\C-s] 'tidal-start-haskell)+ (local-set-key [?\C-c ?\C-v] 'tidal-see-output)+ (local-set-key [?\C-c ?\C-q] 'tidal-quit-haskell)+ (local-set-key [?\C-c ?\C-c] 'tidal-run-line)+ (local-set-key [?\C-c ?\C-e] 'tidal-run-multiple-lines)+ (local-set-key [?\C-c ?\C-r] 'tidal-run-region)+ (local-set-key [?\C-c ?\C-l] 'tidal-load-buffer)+ (local-set-key [?\C-c ?\C-i] 'tidal-interrupt-haskell)+ (local-set-key [?\C-c ?\C-m] 'tidal-run-main)+ (local-set-key [?\C-c ?\C-h] 'tidal-help))++(defun tidal-mode-menu (map)+ "Haskell Tidal menu."+ (define-key map [menu-bar tidal]+ (cons "Haskell-Tidal" (make-sparse-keymap "Haskell-Tidal")))+ (define-key map [menu-bar tidal help]+ (cons "Help" (make-sparse-keymap "Help")))+ (define-key map [menu-bar tidal expression]+ (cons "Expression" (make-sparse-keymap "Expression")))+ (define-key map [menu-bar tidal expression load-buffer]+ '("Load buffer" . tidal-load-buffer))+ (define-key map [menu-bar tidal expression run-main]+ '("Run main" . tidal-run-main))+ (define-key map [menu-bar tidal expression run-region]+ '("Run region" . tidal-run-region))+ (define-key map [menu-bar tidal expression run-multiple-lines]+ '("Run multiple lines" . tidal-run-multiple-lines))+ (define-key map [menu-bar tidal expression run-line]+ '("Run line" . tidal-run-line))+ (define-key map [menu-bar tidal haskell]+ (cons "Haskell" (make-sparse-keymap "Haskell")))+ (define-key map [menu-bar tidal haskell quit-haskell]+ '("Quit haskell" . tidal-quit-haskell))+ (define-key map [menu-bar tidal haskell see-output]+ '("See output" . tidal-see-output))+ (define-key map [menu-bar tidal haskell start-haskell]+ '("Start haskell" . tidal-start-haskell)))++(if tidal-mode-map+ ()+ (let ((map (make-sparse-keymap "Haskell-Tidal")))+ (tidal-mode-keybindings map)+ (tidal-mode-menu map)+ (setq tidal-mode-map map)))++(define-derived-mode+ literate-tidal-mode+ tidal-mode+ "Literate Haskell Tidal"+ "Major mode for interacting with an inferior haskell process."+ (setq tidal-literate-p t)+ (setq haskell-literate 'bird)+ (turn-on-font-lock))++(add-to-list 'auto-mode-alist '("\\.ltidal$" . literate-tidal-mode))++(define-derived-mode+ tidal-mode+ haskell-mode+ "Haskell Tidal"+ "Major mode for interacting with an inferior haskell process."+ (setq tidal-literate-p nil)+ (turn-on-font-lock))++(add-to-list 'auto-mode-alist '("\\.tidal$" . tidal-mode))++(provide 'tidal)