monomer/examples/tutorial/Tutorial04_Tasks.hs
Francisco Vallarino 51ce06f613
Add Monomer logo and badges to README.md (#186)
* 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
2022-06-27 16:25:03 -03:00

99 lines
3.0 KiB
Haskell

{-|
Module : Tutorial04_Tasks
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 '04 - Tasks' tutorial.
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Tutorial04_Tasks where
import Control.Lens
import Data.Text (Text)
import Monomer
import System.Random
import qualified Monomer.Lens as L
data AppModel = AppModel {
_selected :: Int,
_hoverButton :: Bool
} deriving (Eq, Show)
data AppEvent
= AppGenRandom
| AppSaveRandom Int
| AppOnEnterBtn
| AppOnLeaveBtn
deriving (Eq, Show)
makeLenses 'AppModel
buildUI
:: WidgetEnv AppModel AppEvent
-> AppModel
-> WidgetNode AppModel AppEvent
buildUI wenv model = widgetTree where
pushLayers = zstack [
image_ "./assets/images/red-button.png" [fitFill] `nodeVisible` not (model ^. hoverButton),
image_ "./assets/images/red-button-hover.png" [fitFill] `nodeVisible` model ^. hoverButton,
label "Push!" `styleBasic` [textFont "Bold", textSize 20, textCenter]
]
pushButton = box_ [onClick AppGenRandom, onEnter AppOnEnterBtn, onLeave AppOnLeaveBtn] pushLayers
`styleBasic` [width 160, height 160, cursorHand]
numberLabel = labelS (model ^. selected)
`styleBasic` [textFont "Bold", textSize 100, textColor black, textCenter, width 160]
numberedImage url idx = scroll (image_ url [fitNone])
`nodeVisible` (model ^. selected == idx)
imageSet = hstack [
numberedImage "https://picsum.photos/id/1020/800/600" 1,
numberedImage "https://picsum.photos/id/1043/800/600" 2,
numberedImage "https://picsum.photos/id/1047/800/600" 3,
numberedImage "https://picsum.photos/id/1025/800/600" 4,
numberedImage "https://picsum.photos/id/1080/800/600" 5,
numberedImage "https://picsum.photos/id/1059/800/600" 6
] `styleBasic` [padding 10]
widgetTree = vstack [
hstack [
tooltip "Click to pick a random number" pushButton
`styleBasic` [textSize 16, bgColor steelBlue, paddingH 5, radius 5],
numberLabel
],
imageSet
] `styleBasic` [bgColor moccasin]
handleEvent
:: WidgetEnv AppModel AppEvent
-> WidgetNode AppModel AppEvent
-> AppModel
-> AppEvent
-> [AppEventResponse AppModel AppEvent]
handleEvent wenv node model evt = case evt of
AppGenRandom -> [Task $
AppSaveRandom <$> randomRIO (1, 6)
]
AppSaveRandom value -> [Model $ model & selected .~ value]
AppOnEnterBtn -> [Model $ model & hoverButton .~ True]
AppOnLeaveBtn -> [Model $ model & hoverButton .~ False]
main04 :: IO ()
main04 = do
startApp model handleEvent buildUI config
where
config = [
appWindowTitle "Tutorial 04 - Tasks",
appWindowIcon "./assets/images/icon.png",
appTheme darkTheme,
appFontDef "Regular" "./assets/fonts/Roboto-Regular.ttf",
appFontDef "Bold" "./assets/fonts/Roboto-Bold.ttf"
]
model = AppModel {
_selected = 0,
_hoverButton = False
}