mirror of
https://github.com/fjvallarino/monomer.git
synced 2024-09-11 12:05:35 +03:00
51ce06f613
* Add new Monomer logo and badges to README.md * Fix sub-title styling * Add support for loading any image format to use as application icon * Update Monomer icon image * Update examples and tutorials to use new icon image * Adjust logo background color
114 lines
2.8 KiB
Haskell
114 lines
2.8 KiB
Haskell
{-|
|
|
Module : Tutorial03_LifeCycle
|
|
Copyright : (c) 2018 Francisco Vallarino
|
|
License : BSD-3-Clause (see the LICENSE file)
|
|
Maintainer : fjvallarino@gmail.com
|
|
Stability : experimental
|
|
Portability : non-portable
|
|
|
|
Main module for the '03 - LifeCycle' tutorial.
|
|
-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
module Tutorial03_LifeCycle where
|
|
|
|
import Control.Lens
|
|
import Data.Text (Text)
|
|
import Monomer
|
|
import TextShow
|
|
|
|
import qualified Data.Text as T
|
|
import qualified Monomer.Lens as L
|
|
|
|
data ListItem = ListItem {
|
|
_ts :: Millisecond,
|
|
_text :: Text
|
|
} deriving (Eq, Show)
|
|
|
|
data AppModel = AppModel {
|
|
_newItemText :: Text,
|
|
_items :: [ListItem]
|
|
} deriving (Eq, Show)
|
|
|
|
data AppEvent
|
|
= AppInit
|
|
| AddItem
|
|
| RemoveItem Int
|
|
deriving (Eq, Show)
|
|
|
|
makeLenses 'ListItem
|
|
makeLenses 'AppModel
|
|
|
|
buildUI
|
|
:: WidgetEnv AppModel AppEvent
|
|
-> AppModel
|
|
-> WidgetNode AppModel AppEvent
|
|
buildUI wenv model = widgetTree where
|
|
listItem idx item = vstack [
|
|
label_ (item ^. text) [ellipsis] `styleBasic` [textSize 12, paddingH 8],
|
|
spacer,
|
|
hstack [
|
|
textField (items . singular (ix idx) . text),
|
|
spacer,
|
|
button "Delete" (RemoveItem idx)
|
|
]
|
|
] `nodeKey` showt (item ^. ts) `styleBasic` [paddingT 10]
|
|
|
|
widgetTree = vstack [
|
|
keystroke [("Enter", AddItem)] $ hstack [
|
|
label "Description:",
|
|
spacer,
|
|
textField_ newItemText [placeholder "Write here!"]
|
|
`nodeKey` "description",
|
|
spacer,
|
|
button "Add" AddItem
|
|
`styleBasic` [paddingH 5]
|
|
`nodeEnabled` (model ^. newItemText /= "")
|
|
],
|
|
|
|
separatorLine `styleBasic` [paddingT 20, paddingB 10],
|
|
|
|
vstack (zipWith listItem [0..] (model ^. items))
|
|
] `styleBasic` [padding 20]
|
|
|
|
handleEvent
|
|
:: WidgetEnv AppModel AppEvent
|
|
-> WidgetNode AppModel AppEvent
|
|
-> AppModel
|
|
-> AppEvent
|
|
-> [AppEventResponse AppModel AppEvent]
|
|
handleEvent wenv node model evt = case evt of
|
|
AppInit -> []
|
|
AddItem
|
|
| model ^. newItemText /= "" -> [
|
|
Model $ model
|
|
& newItemText .~ ""
|
|
& items .~ newItem : model ^. items,
|
|
SetFocusOnKey "description"]
|
|
RemoveItem idx -> [Model $ model
|
|
& items .~ removeIdx idx (model ^. items)]
|
|
_ -> []
|
|
where
|
|
newItem = ListItem (currentTimeMs wenv) (model ^. newItemText)
|
|
|
|
removeIdx :: Int -> [a] -> [a]
|
|
removeIdx idx lst = part1 ++ drop 1 part2 where
|
|
(part1, part2) = splitAt idx lst
|
|
|
|
main03 :: IO ()
|
|
main03 = do
|
|
startApp model handleEvent buildUI config
|
|
where
|
|
config = [
|
|
appWindowTitle "Tutorial 03 - Merging",
|
|
appWindowIcon "./assets/images/icon.png",
|
|
appTheme darkTheme,
|
|
appFontDef "Regular" "./assets/fonts/Roboto-Regular.ttf",
|
|
appInitEvent AppInit
|
|
]
|
|
model = AppModel {
|
|
_newItemText = "",
|
|
_items = []
|
|
}
|