mirror of
https://github.com/fjvallarino/monomer.git
synced 2024-10-26 19:49:50 +03:00
81 lines
2.0 KiB
Haskell
81 lines
2.0 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
module Tutorial05_Producers where
|
|
|
|
import Control.Concurrent (threadDelay)
|
|
import Control.Lens
|
|
import Data.Text (Text)
|
|
import Data.Time
|
|
import Monomer
|
|
|
|
import qualified Data.Text as T
|
|
import qualified Monomer.Lens as L
|
|
|
|
newtype AppModel = AppModel {
|
|
_currentTime :: TimeOfDay
|
|
} deriving (Eq, Show)
|
|
|
|
data AppEvent
|
|
= AppInit
|
|
| AppSetTime TimeOfDay
|
|
deriving (Eq, Show)
|
|
|
|
makeLenses 'AppModel
|
|
|
|
buildUI
|
|
:: WidgetEnv AppModel AppEvent
|
|
-> AppModel
|
|
-> WidgetNode AppModel AppEvent
|
|
buildUI wenv model = widgetTree where
|
|
timeString = T.pack . show $ model ^. currentTime
|
|
|
|
timeLabel = label (T.takeWhile (/= '.') timeString)
|
|
`styleBasic` [textFont "Bold", textSize 80, textCenter, textMiddle, flexHeight 100]
|
|
|
|
widgetTree = vstack [
|
|
animFadeIn timeLabel `nodeKey` "fadeTimeLabel"
|
|
]
|
|
|
|
handleEvent
|
|
:: WidgetEnv AppModel AppEvent
|
|
-> WidgetNode AppModel AppEvent
|
|
-> AppModel
|
|
-> AppEvent
|
|
-> [AppEventResponse AppModel AppEvent]
|
|
handleEvent wenv node model evt = case evt of
|
|
AppInit -> [Producer timeOfDayProducer]
|
|
AppSetTime time -> fadeInMsg time ++ [Model $ model & currentTime .~ time]
|
|
where
|
|
fadeInMsg time
|
|
| truncate (todSec time) `mod` 10 /= 0 = []
|
|
| otherwise = [Message "fadeTimeLabel" AnimationStart]
|
|
|
|
timeOfDayProducer :: (AppEvent -> IO ()) -> IO ()
|
|
timeOfDayProducer sendMsg = do
|
|
time <- getLocalTimeOfDay
|
|
sendMsg (AppSetTime time)
|
|
threadDelay $ 1000 * 1000
|
|
timeOfDayProducer sendMsg
|
|
|
|
getLocalTimeOfDay :: IO TimeOfDay
|
|
getLocalTimeOfDay = do
|
|
time <- getZonedTime
|
|
return . localTimeOfDay . zonedTimeToLocalTime $ time
|
|
|
|
main05 :: IO ()
|
|
main05 = do
|
|
time <- getLocalTimeOfDay
|
|
startApp (model time) handleEvent buildUI config
|
|
where
|
|
config = [
|
|
appWindowTitle "Tutorial 05 - Producers",
|
|
appTheme darkTheme,
|
|
appFontDef "Regular" "./assets/fonts/Roboto-Regular.ttf",
|
|
appFontDef "Bold" "./assets/fonts/Roboto-Bold.ttf",
|
|
appInitEvent AppInit
|
|
]
|
|
model time = AppModel {
|
|
_currentTime = time
|
|
}
|