mirror of
https://github.com/fjvallarino/monomer.git
synced 2024-09-11 12:05:35 +03:00
* 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
99 lines
3.0 KiB
Haskell
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
|
|
}
|