Commit 45073a43 authored by Guerric Chupin's avatar Guerric Chupin

Hlint suggestions.

parent d1768d68
......@@ -2,6 +2,8 @@
-- This module contains function that allow the particular geometry of
-- the board to not cause too much problems.
--
-- They are stolen from the gtk-helpers library.
module RMCA.GUI.HelpersRewrite where
......@@ -130,7 +132,7 @@ boardOnPieceDragDrop :: Ix index =>
-> ((index, index) -> (index, index) -> IO ()) -> IO()
boardOnPieceDragDrop board f = void $ do
widgetAddEvents (boardDrawingArea board) [ButtonPressMask, ButtonReleaseMask]
(boardDrawingArea board) `on` buttonReleaseEvent $ returning False $ liftIO $ do
boardDrawingArea board `on` buttonReleaseEvent $ returning False $ liftIO $ do
drag <- readIORef (dragEnabled board)
origM <- readIORef (draggingFrom board)
destM <- readIORef (draggingTo board)
......@@ -168,7 +170,7 @@ attachGameRules game = do
vgRef <- newIORef game
-- Set the initial board state
mapM_ (\(x,y) -> boardSetPiece x y board) $
mapM_ (\(x,y) -> boardSetPiece x y board)
[((x,y),(pl,pc)) | (x,y,pl,pc) <- allPieces (gameS game)]
board `boardOnPieceDragStart` \pos' -> do
......
......@@ -39,17 +39,13 @@ boardSwitch rPh = dSwitch (singleBoard rPh *** (identity >>> notYet)) fnSwitch
--------------------------------------------------------------------------------
-- Machinery to make boards run in parallel
--------------------------------------------------------------------------------
{-
routeBoard :: (a -> b -> c) -> (a, M.IntMap b) -> M.IntMap sf -> M.IntMap (c,sf)
routeBoard formInput (glob, locs) sfs =
M.intersectionWith (,) (formInput glob <$> locs) sfs
-}
boardRun' :: M.IntMap (SF (Event AbsBeat,Board,Layer,BoardRun)
(Event ([PlayHead],[Note])))
-> SF (Event AbsBeat, BoardRun, (M.IntMap (Board,Layer)))
-> SF (Event AbsBeat, BoardRun, M.IntMap (Board,Layer))
(M.IntMap (Event ([PlayHead],[Note])))
boardRun' iSF = boardRun'' iSF (lengthChange iSF)
where boardRun'' iSF swSF = pSwitch (routeBoard) iSF swSF contSwitch
where boardRun'' iSF swSF = pSwitch routeBoard iSF swSF contSwitch
contSwitch contSig (oldSig, newSig) = boardRun'' newSF
(lengthChange newSF >>> notYet)
where newSF = foldr (\k m -> M.insert k boardSF m)
......@@ -65,8 +61,8 @@ boardRun' iSF = boardRun'' iSF (lengthChange iSF)
routeBoard :: (Event AbsBeat,BoardRun,M.IntMap (Board,Layer))
-> M.IntMap sf
-> M.IntMap ((Event AbsBeat,Board,Layer,BoardRun),sf)
routeBoard (evs,br,map) sfs =
M.intersectionWith (,) ((\(b,l) -> (evs,b,l,br)) <$> map) sfs
routeBoard (evs,br,map) =
M.intersectionWith (,) ((\(b,l) -> (evs,b,l,br)) <$> map)
boardRun :: (Tempo, BoardRun, M.IntMap (Board,Layer))
-> SF (Tempo, BoardRun, M.IntMap (Board,Layer))
......
......@@ -85,7 +85,7 @@ main = do
let eventsMap = M.filter isEvent out
writePh chan val =
fromMaybeM_ $ fmap (`reactiveValueWrite` val) $
fromMaybeM_ $ (`reactiveValueWrite` val) <$>
M.lookup chan phRVMap
noteMap = M.map (eventToList . snd . splitE) out
sequence_ $ M.mapWithKey writePh $
......
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