Commit 92e82a94 authored by Guerric Chupin's avatar Guerric Chupin

Little correction to tile rotation.

parent 45073a43
......@@ -33,4 +33,6 @@ html/
*.aux
*.hp
*.prof
*.ps
\ No newline at end of file
*.ps
*.html
*.folded
\ No newline at end of file
......@@ -88,7 +88,7 @@ varFreqSine :: SF DTime Double
varFreqSine = sin ^<< (2*pi*) ^<< (`mod'` 1) ^<< integral <<^ (1/)
repeatedlyS :: a -> SF DTime (Event a)
repeatedlyS x = edgeBy (\a b -> if a * b < 0 then Just x else Nothing) 0
repeatedlyS x = edgeBy (\a b -> maybeIf (a * b > 0) $> x) 0
<<< varFreqSine <<^ (2*)
-- Similar to onChange but contains its initial value in the first
......
......@@ -11,6 +11,7 @@ module RMCA.GUI.Board ( GUICell (..)
, fromGUICoords
, validArea
, Player(..)
, actualTile
) where
import Control.Monad
......
......@@ -60,36 +60,38 @@ createNotebook addLayerRV rmLayerRV layerMCBMVar guiCellMCBMVar = do
let clickHandler ioBoard = do
state <- newEmptyMVar
boardOnPress ioBoard
(\iPos -> liftIO $ do
(\iPos' -> liftIO $ do
let iPos = actualTile iPos'
postGUIAsync $ void $ tryPutMVar state iPos
return True
)
boardOnRelease ioBoard
(\fPos -> do
button <- eventButton
liftIO $ postGUIAsync $ do
mp <- boardGetPiece fPos ioBoard
mstate <- tryTakeMVar state
when (fPos `elem` validArea && isJust mp) $ do
let piece = snd $ fromJust mp
when (button == RightButton && maybe False (== fPos) mstate) $ do
let nCell = rotateGUICell piece
boardSetPiece fPos (Player,nCell) ioBoard
nmp <- boardGetPiece fPos ioBoard
when (button == LeftButton && isJust nmp) $ do
let nCell = snd $ fromJust nmp
mOHid <- tryTakeMVar guiCellHidMVar
forM_ mOHid $ removeCallbackMCBMVar guiCellMCBMVar
reactiveValueWrite guiCellMCBMVar nCell
nHid <- installCallbackMCBMVar guiCellMCBMVar $ do
cp <- reactiveValueRead curChanRV
guiVal <- reactiveValueRead guiCellMCBMVar
mChanRV <- M.lookup cp <$> reactiveValueRead chanMapRV
when (isNothing mChanRV) $ error "Can't get piece array!"
let (_,pieceArrRV,_) = fromJust mChanRV
reactiveValueWrite (pieceArrRV ! fPos) guiVal
putMVar guiCellHidMVar nHid
return True
(\fPos' -> do
let fPos = actualTile fPos'
button <- eventButton
liftIO $ postGUIAsync $ do
mp <- boardGetPiece fPos ioBoard
mstate <- tryTakeMVar state
when (fPos `elem` validArea && isJust mp) $ do
let piece = snd $ fromJust mp
when (button == RightButton && maybe False (== fPos) mstate) $ do
let nCell = rotateGUICell piece
boardSetPiece fPos (Player,nCell) ioBoard
nmp <- boardGetPiece fPos ioBoard
when (button == LeftButton && isJust nmp) $ do
let nCell = snd $ fromJust nmp
mOHid <- tryTakeMVar guiCellHidMVar
forM_ mOHid $ removeCallbackMCBMVar guiCellMCBMVar
reactiveValueWrite guiCellMCBMVar nCell
nHid <- installCallbackMCBMVar guiCellMCBMVar $ do
cp <- reactiveValueRead curChanRV
guiVal <- reactiveValueRead guiCellMCBMVar
mChanRV <- M.lookup cp <$> reactiveValueRead chanMapRV
when (isNothing mChanRV) $ error "Can't get piece array!"
let (_,pieceArrRV,_) = fromJust mChanRV
reactiveValueWrite (pieceArrRV ! fPos) guiVal
putMVar guiCellHidMVar nHid
return True
)
boardCont <- backgroundContainerNew
......
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