summaryrefslogtreecommitdiffstats
path: root/lib/Phi/Widget.hs
blob: a4850e7df46e7f7665e46512ca6b15d75881f829 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
{-# LANGUAGE ExistentialQuantification, TypeFamilies #-}

module Phi.Widget ( Widget(..)
                  , WidgetClass(..)
                  , WidgetState(..)
                  , separator
                  , createWidgetState
                  , layoutWidgets
                  , renderWidgets
                  ) where

import Control.Monad

import Graphics.Rendering.Cairo


class WidgetClass a where
  type WidgetData a :: *
  
  initialState :: a -> WidgetData a
  
  minSize :: a -> Int
  
  weight :: a -> Float
  weight _ = 0

  layout :: a -> Int -> Int -> WidgetData a
  layout widget _ _ = initialState widget
  
  render :: a -> WidgetData a -> Int -> Int -> Render ()

data Widget = forall a. WidgetClass a => Widget a

data WidgetState = forall a. WidgetClass a => WidgetState { stateWidget      :: a
                                                          , stateWidth       :: Int 
                                                          , stateHeight      :: Int
                                                          , statePrivateData :: WidgetData a
                                                          }

createWidgetState :: Widget -> WidgetState
createWidgetState (Widget w) = WidgetState { stateWidget = w
                                           , stateWidth = 0
                                           , stateHeight = 0
                                           , statePrivateData = initialState w
                                           }

layoutWidgets :: [WidgetState] -> Int -> Int -> [WidgetState]
layoutWidgets widgets w h = map layoutWidget widgets
  where
    layoutWidget state = state { stateWidth = w, stateHeight = h }

renderWidgets :: [WidgetState] -> Render ()
renderWidgets widgets = forM_ widgets $ \WidgetState { stateWidget = widget, stateWidth = w, stateHeight = h, statePrivateData = priv } -> render widget priv w h 


data Separator = Separator Int Float

instance WidgetClass Separator where
  type WidgetData Separator = ()
  initialState _ = ()
  
  minSize (Separator s _) = s
  weight (Separator _ w) = w
  render _ _ _ _ = return ()

separator :: Int -> Float -> Widget
separator s w = Widget $ Separator s w