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
167 lines
4.1 KiB
Haskell
167 lines
4.1 KiB
Haskell
{-|
|
|
Module : Tutorial06_Composite
|
|
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 '06 - Composite' tutorial.
|
|
-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
module Tutorial06_Composite where
|
|
|
|
import Control.Concurrent (threadDelay)
|
|
import Control.Lens
|
|
import Data.List
|
|
import Data.Text (Text)
|
|
import Monomer
|
|
import TextShow
|
|
|
|
import qualified Data.Text as T
|
|
import qualified Monomer.Lens as L
|
|
|
|
data CompModel = CompModel {
|
|
_listA :: [Int],
|
|
_listB :: [Int]
|
|
} deriving (Eq, Show)
|
|
|
|
data CompEvent
|
|
= DropToA Int
|
|
| DropToB Int
|
|
deriving (Eq, Show)
|
|
|
|
data AppModel = AppModel {
|
|
_showDialog :: Bool,
|
|
_parentModel :: CompModel,
|
|
_dialogModel :: CompModel
|
|
} deriving (Eq, Show)
|
|
|
|
data AppEvent
|
|
= AppInit
|
|
| ShowDialog
|
|
| CloseDialog
|
|
deriving (Eq, Show)
|
|
|
|
makeLenses 'CompModel
|
|
makeLenses 'AppModel
|
|
|
|
buildUIComp
|
|
:: WidgetEnv CompModel CompEvent
|
|
-> CompModel
|
|
-> WidgetNode CompModel CompEvent
|
|
buildUIComp wenv model = widgetTree where
|
|
sectionBg = rgbHex "#80B6FD"
|
|
sectionHover = rgbHex "#A0D8FD"
|
|
textDrag = rgbHex "#E0FFFF"
|
|
|
|
itemA val = label ("Item: " <> showt val)
|
|
`styleBasic` [textColor black, padding 5]
|
|
|
|
dragItem val = draggable_ val
|
|
[draggableStyle [bgColor textDrag, radius 5]]
|
|
(itemA val)
|
|
`styleBasic` [cursorHand]
|
|
|
|
dragList items = vstack (dragItem <$> items)
|
|
|
|
dropContainer target list = dropTarget_ target
|
|
[dropTargetStyle [radius 10, bgColor sectionHover]]
|
|
(dragList (model ^. list))
|
|
`styleBasic` [minWidth 100, flexHeight 100, padding 5, radius 10, bgColor sectionBg]
|
|
|
|
dropTargetA = dropContainer DropToA listA
|
|
dropTargetB = dropContainer DropToB listB
|
|
|
|
widgetTree = hstack [
|
|
box dropTargetA `styleBasic` [paddingR 5],
|
|
box dropTargetB `styleBasic` [paddingL 5]
|
|
]
|
|
|
|
handleEventComp
|
|
:: WidgetEnv CompModel CompEvent
|
|
-> WidgetNode CompModel CompEvent
|
|
-> CompModel
|
|
-> CompEvent
|
|
-> [EventResponse CompModel CompEvent sp ep]
|
|
handleEventComp wenv node model evt = case evt of
|
|
DropToA val -> [Model $ model
|
|
& listA .~ sort (val : model ^. listA)
|
|
& listB .~ delete val (model ^. listB)]
|
|
|
|
DropToB val -> [Model $ model
|
|
& listA .~ delete val (model ^. listA)
|
|
& listB .~ sort (val : model ^. listB)]
|
|
|
|
compWidget
|
|
:: (WidgetModel sp, WidgetEvent ep)
|
|
=> ALens' sp CompModel
|
|
-> WidgetNode sp ep
|
|
compWidget field = composite "compWidget" field buildUIComp handleEventComp
|
|
|
|
buildUI
|
|
:: WidgetEnv AppModel AppEvent
|
|
-> AppModel
|
|
-> WidgetNode AppModel AppEvent
|
|
buildUI wenv model = widgetTree where
|
|
baseLayer = vstack [
|
|
compWidget parentModel,
|
|
spacer,
|
|
hstack [
|
|
button "Show Dialog" ShowDialog
|
|
]
|
|
] `styleBasic` [padding 10]
|
|
|
|
closeIcon = icon IconClose
|
|
`styleBasic` [width 16, height 16, fgColor black, cursorHand]
|
|
|
|
dialogLayer = vstack [
|
|
hstack [
|
|
filler,
|
|
box_ [alignTop, onClick CloseDialog] closeIcon
|
|
],
|
|
spacer,
|
|
compWidget dialogModel
|
|
] `styleBasic` [width 500, height 400, padding 10, radius 10, bgColor darkGray]
|
|
|
|
widgetTree = zstack [
|
|
baseLayer,
|
|
box_ [alignCenter, alignMiddle] dialogLayer
|
|
`nodeVisible` model ^. showDialog
|
|
`styleBasic` [bgColor (gray & L.a .~ 0.8)]
|
|
]
|
|
|
|
handleEvent
|
|
:: WidgetEnv AppModel AppEvent
|
|
-> WidgetNode AppModel AppEvent
|
|
-> AppModel
|
|
-> AppEvent
|
|
-> [AppEventResponse AppModel AppEvent]
|
|
handleEvent wenv node model evt = case evt of
|
|
AppInit -> []
|
|
ShowDialog -> [Model $ model & showDialog .~ True]
|
|
CloseDialog -> [Model $ model & showDialog .~ False]
|
|
|
|
main06 :: IO ()
|
|
main06 = do
|
|
startApp model handleEvent buildUI config
|
|
where
|
|
config = [
|
|
appWindowTitle "Tutorial 06 - Composite",
|
|
appWindowIcon "./assets/images/icon.png",
|
|
appTheme darkTheme,
|
|
appFontDef "Regular" "./assets/fonts/Roboto-Regular.ttf",
|
|
appInitEvent AppInit
|
|
]
|
|
compModel = CompModel {
|
|
_listA = [1..10],
|
|
_listB = []
|
|
}
|
|
model = AppModel {
|
|
_showDialog = False,
|
|
_parentModel = compModel,
|
|
_dialogModel = compModel
|
|
}
|