84 lines
1.9 KiB
Haskell
84 lines
1.9 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
module Main (main) where
|
|
|
|
import Control.Lens
|
|
|
|
import Monomer
|
|
import TextShow
|
|
|
|
import Lib
|
|
|
|
data AppModel = AppModel {
|
|
_clickCount :: Int,
|
|
_curTimeRepresentation :: String
|
|
} deriving (Eq, Show)
|
|
|
|
data AppEvent = AppInit | AppIncrease deriving (Show, Eq)
|
|
|
|
makeLenses 'AppModel
|
|
|
|
clockWidget :: WidgetNode s e
|
|
clockWidget = clockWidget_ def
|
|
|
|
clockWidget_ def = defaultWidgetNode "clock" newWidget where
|
|
newWidget = createSingle () def {
|
|
singleMerge = merge,
|
|
singleHandleEvent = handleEvent,
|
|
singleHandleMessage = handleMessage,
|
|
singleGetSizeReq = getSizeReq,
|
|
singleRender = render
|
|
}
|
|
|
|
merge wenv node oldNode oldState = result where
|
|
newNode = node
|
|
& L.widget .~ makeCanvas cfg oldState
|
|
result = resultNode newNode
|
|
|
|
|
|
buildUI
|
|
:: WidgetEnv AppModel AppEvent
|
|
-> AppModel
|
|
-> WidgetNode AppModel AppEvent
|
|
buildUI _wenv model = widgetTree where
|
|
widgetTree = vstack [
|
|
label $ showt (model ^. curTimeRepresentation),
|
|
spacer,
|
|
hstack [
|
|
label $ "Click count: " <> showt (model ^. clickCount),
|
|
spacer,
|
|
button "Increase count" AppIncrease
|
|
]
|
|
] `styleBasic` [padding 10]
|
|
|
|
handleEvent
|
|
:: WidgetEnv AppModel AppEvent
|
|
-> WidgetNode AppModel AppEvent
|
|
-> AppModel
|
|
-> AppEvent
|
|
-> [AppEventResponse AppModel AppEvent]
|
|
handleEvent _wenv _node model evt = case evt of
|
|
AppInit -> []
|
|
AppIncrease -> [Model (model & clickCount +~ 1)]
|
|
|
|
|
|
main :: IO ()
|
|
main = do
|
|
putStrLn "haskell-clock"
|
|
guiMain
|
|
|
|
guiMain :: IO ()
|
|
guiMain = do
|
|
curTime <- curTimeString
|
|
let model = AppModel 0 curTime
|
|
startApp model handleEvent buildUI config
|
|
where
|
|
config = [
|
|
appWindowTitle "Haskell Clock",
|
|
--appWindowIcon "./assets/images/icon.png",
|
|
appTheme darkTheme,
|
|
appFontDef "Regular" "/usr/share/fonts/TTF/FiraCode-Regular.ttf",
|
|
appInitEvent AppInit
|
|
]
|