{-| 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.bmp", appTheme darkTheme, appFontDef "Regular" "./assets/fonts/Roboto-Regular.ttf", appFontDef "Bold" "./assets/fonts/Roboto-Bold.ttf" ] model = AppModel { _selected = 0, _hoverButton = False }