68 lines
2.1 KiB
Haskell
68 lines
2.1 KiB
Haskell
|
{-# 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
|