Main.hs

{-|
Module      : Main
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 'Custom OpenGL' example.
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module Main where

import Control.Lens
import Data.Text (Text)
import Monomer

import qualified Data.Map as M
import qualified Monomer.Lens as L

import OpenGLWidget

data AppModel = AppModel {
  _color1 :: Color,
  _color2 :: Color,
  _color3 :: Color,
  _color4 :: Color
} deriving (Eq, Show)

data AppEvent
  = AppInit
  deriving (Eq, Show)

makeLenses 'AppModel

buildUI
  :: WidgetEnv AppModel AppEvent
  -> AppModel
  -> WidgetNode AppModel AppEvent
buildUI wenv model = widgetTree where
  colorsMap = M.fromList [(red, "Red"), (green, "Green"), (blue, "Blue"), (orange, "Orange")]
  colors = M.keys colorsMap
  colorDropdown field = textDropdown_ field colors (colorsMap M.!) []

  widgetTree = vstack [
      hstack [
        label "Color 1:",
        spacer,
        colorDropdown color1,
        spacer,
        label "Color 2:",
        spacer,
        colorDropdown color2,
        spacer,
        label "Color 3:",
        spacer,
        colorDropdown color3,
        spacer,
        label "Color 4:",
        spacer,
        colorDropdown color4
      ],
      spacer,
      vgrid [
        hgrid [
          openGLWidget (model ^. color1)
            `styleBasic` [padding 20],
          scroll (openGLWidget (model ^. color2) `styleBasic` [width 800, height 800])
            `styleBasic` [padding 20]
        ],
        hgrid [
          openGLWidget (model ^. color3)
            `styleBasic` [padding 20],
          openGLWidget (model ^. color4)
            `styleBasic` [padding 20]
        ]
      ]
    ] `styleBasic` [padding 10]

handleEvent
  :: WidgetEnv AppModel AppEvent
  -> WidgetNode AppModel AppEvent
  -> AppModel
  -> AppEvent
  -> [AppEventResponse AppModel AppEvent]
handleEvent wenv node model evt = case evt of
  AppInit -> []

main :: IO ()
main = do
  startApp model handleEvent buildUI config
  where
    config = [
      appWindowTitle "OpenGL",
      appWindowIcon "./assets/images/icon.bmp",
      appTheme darkTheme,
      appFontDef "Regular" "./assets/fonts/Roboto-Regular.ttf",
      appInitEvent AppInit
      ]
    model = AppModel red green blue orange