Commit f12cedf3 authored by Guerric Chupin's avatar Guerric Chupin

Solved memory leak issue when Jack is connected. There still is a leak when Jack is disconnected.

parent 75e792b4
cloc|https://github.com/AlDanial/cloc v 1.66 T=0.09 s (299.7 files/s, 25153.0 lines/s)
cloc|github.com/AlDanial/cloc v 1.70 T=0.04 s (502.7 files/s, 62473.3 lines/s)
--- | ---
Language|files|blank|comment|code
:-------|-------:|-------:|-------:|-------:
Haskell|26|341|439|1402
Haskell|21|384|371|1855
--------|--------|--------|--------|--------
SUM:|26|341|439|1402
SUM:|21|384|371|1855
......@@ -19,7 +19,7 @@ data-files: img/*.png, img/*.svg
executable RMCA
main-is: RMCA/Main.hs
-- other-modules:
other-modules: Paths_RMCA
other-extensions: MultiParamTypeClasses
, ScopedTypeVariables
, Arrows
......@@ -47,4 +47,41 @@ executable RMCA
hs-source-dirs: src
build-tools: hsc2hs
default-language: Haskell2010
ghc-options: -O2 -threaded -W
\ No newline at end of file
ghc-options: -O2 -threaded -W
-- executable RMCA.prof
-- main-is: RMCA/Main.hs
-- other-modules: Paths_RMCA
-- other-extensions: MultiParamTypeClasses
-- , ScopedTypeVariables
-- , Arrows
-- , FlexibleInstances
-- , TypeSynonymInstances
-- , FlexibleContexts
-- , GeneralizedNewtypeDeriving
-- build-depends: base >=4.8 && <4.10
-- , array >=0.5 && <0.6
-- , cairo >=0.13 && <0.14
-- , keera-hails-reactivevalues >=0.2 && <0.3
-- , Yampa >=0.10 && <0.11
-- , gtk-helpers >=0.0 && <0.1
-- , gtk >=0.14 && <0.15
-- , keera-hails-reactive-gtk >=0.3 && <0.4
-- , keera-hails-reactive-yampa >=0.0 && <0.1
-- , containers >=0.5 && <0.6
-- , jack >=0.7 && <0.8
-- , midi >=0.2 && <0.3
-- , explicit-exception >=0.1 && <0.2
-- , transformers >=0.4 && <0.6
-- , event-list >=0.1 && <0.2
-- , keera-callbacks >=0.1 && <0.2
-- , glib >=0.13 && <0.14
-- hs-source-dirs: src
-- build-tools: hsc2hs
-- default-language: Haskell2010
-- ghc-options: -O2
-- -threaded
-- -W
-- -fprof-auto
-- -prof
-- "-with-rtsopts=-p -s -h -i0.1"
......@@ -30,7 +30,7 @@ fromMaybeM_ = fromMaybe (return ())
stepBack :: SF a (Maybe a)
stepBack = sscan f (Nothing, Nothing) >>^ snd
where f :: (Maybe a, Maybe a) -> a -> (Maybe a, Maybe a)
f (Nothing,Nothing) x' = (Just x', Nothing)
f (Nothing,_) x' = (Just x', Nothing)
f (Just x, _) x' = (Just x', Just x)
-- Just like stepBack but the output value is always defined and is
......@@ -47,10 +47,18 @@ onChange = proc x -> do
x' <- stepBack -< x
let makeEvent x x'
| isNothing x' = NoEvent
| isJust x' = let x'' = fromJust x' in
| otherwise = let x'' = fromJust x' in
if x'' == x then NoEvent else Event x
returnA -< makeEvent x x'
varFreqSine :: SF DTime Double
varFreqSine = sin ^<< (2*pi*) ^<< integral <<^ (1/)
repeatedlyS :: a -> SF DTime (Event a)
repeatedlyS x = proc dt -> do
(sw,sw') <- (identity &&& stepBack) <<< varFreqSine -< 2*dt
edgeTag x <<^ maybe True (< 0) -< (*) <$> return sw <*> sw'
-- Similar to onChange but contains its initial value in the first
-- event.
onChange' :: (Eq a) => SF a (Event a)
......@@ -59,7 +67,7 @@ onChange' = proc x -> do
-- If it's the first value, throw an Event, else behave like onChange.
let makeEvent x x'
| isNothing x' = Event x
| isJust x' = let x'' = fromJust x' in
| otherwise = let x'' = fromJust x' in
if x'' == x then NoEvent else Event x
returnA -< makeEvent x x'
......
......@@ -8,6 +8,7 @@ import FRP.Yampa
import RMCA.Auxiliary
import RMCA.Semantics
{-
-- The initial value is arbitrary but never appears because the switch
-- is immediate.
metronome :: SF Tempo (Event Beat)
......@@ -18,6 +19,9 @@ metronome = switch (repeatedly (tempoToQNoteIvl 120) ()
metronome' t = switch (repeatedly (tempoToQNoteIvl t) ()
&&&
onChange) metronome'
-}
metronome :: SF Tempo (Event Beat)
metronome = repeatedlyS () <<^ tempoToQNoteIvl
-- Tempo is the number of quarter notes per minute.
tempoToQNoteIvl :: Tempo -> DTime
......
......@@ -9,24 +9,6 @@ import RMCA.Semantics
data BoardRun = BoardStart | BoardStop deriving Eq
{-
-- The state of the board is described by the list of the playheads
-- and the different actions onto the board.
boardAction :: SF ((Board, Layer, [PlayHead]), Event BeatNo)
(Event ([PlayHead], [Note]))
boardAction = proc ((board, Layer { relPitch = rp
, strength = s
},ph), ebno) ->
arr $ fmap (uncurry5 advanceHeads)
-< ebno `tag` (board, fromEvent ebno, rp, s, ph)
--returnA -< traceShow e e
boardSF :: SF (Board, Layer, [PlayHead], Tempo) (Event ([PlayHead], [Note]))
boardSF = proc (board, l, ph, t) -> do
ebno <- layerMetronome -< (t, l)
boardAction -< ((board, l, ph), ebno)
-}
singleBoard :: [PlayHead]
-> SF (Board, Layer, Event BeatNo) (Event ([PlayHead], [Note]))
singleBoard iPh = proc (board, Layer { relPitch = rp
......
{-# LANGUAGE Arrows #-}
{-# LANGUAGE Arrows, TupleSections #-}
module RMCA.Layer.Layer where
......@@ -20,16 +20,11 @@ layerTempo :: SF (Tempo, Layer) LTempo
layerTempo = proc (t, Layer { relTempo = r }) ->
returnA -< floor $ r * fromIntegral t
-- The layer is modified after the beat as been
layerMetronome' :: BeatNo -> SF (Tempo, Layer) (Event BeatNo)
layerMetronome' b = proc (t, l@Layer { beatsPerBar = bpb }) -> do
eb <- metronome <<< layerTempo -< (t, l)
returnA -< eb `tag` nextBeatNo bpb b
-- /!\ To be changed in the initialization of the bpb /!\
layerMetronome :: SF (Tempo, Layer) (Event BeatNo)
layerMetronome = layerMetronome'' 0
where layerMetronome'' no = dSwitch (layerMetronome' no >>^ dup)
layerMetronome''
layerMetronome = proc (t,l@Layer { beatsPerBar = bpb }) -> do
eb <- metronome <<< layerTempo -< (t,l)
accumBy (\bn bpb -> nextBeatNo bpb bn) 1 -< eb `tag` bpb
layerRV :: CBMVar Layer -> ReactiveFieldReadWrite IO Layer
layerRV mvar = ReactiveFieldReadWrite setter getter notifier
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment