packages feed

lui (empty) → 0.0.1

raw patch · 20 files changed

+1364/−0 lines, 20 filesdep +SDLdep +basedep +containerssetup-changed

Dependencies added: SDL, base, containers, haskell98, haskgame, mtl

Files

+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ TODO view
@@ -0,0 +1,49 @@+* Restructure it as a library and upload to hackage.+  Export lists everywhere!+  * Mention its HaskGame based (it uses its Vector2 type/etc)+* Abstract away SDL keyboard keys, events, flip and delay+  * Implement a GLUT-based version++* Grid with delete row/column, Box with delete item?++* Animations:+  * Draw -> Animate?+    * Can use ID's on all drawings, and have it animate stuff moving around++Questions:++* After chat with conal:++  * type FontMap = Map String Font+  * type Draw = FontMap -> Image+  * render :: Font -> (Image, Size)+    * unsafePerformIO all font renderings?+    * Have Size be an opaque type usable only for Image manipulations?++* Is the "Clipboard" a good idea?+  * Maybe have a "Clipring" instead?++  * Clipring is a list of N items, and showing it shows one line per item+    with the "summary" of each.++  * When whole content fits in line it is shown, otherwise, it is+    "summarized". Each model needs to be associated with ++  * Bottom line of the screen can show summary of top clipring item+  * Clipring accessible with some key, animating all the contents up,+    allowing to move item to the top++* What do widget actions do, besides updating the model?+  1. Read and write from the clipboard (Clipboard monad?)+  2. "Signal"? Probably not, as it implies a side-effect.++* Consider removing the accessor arg and using adapter always+  This means child containers have to be parameterized on the child+  rather than on the generic model, so Grid is not Widget model+  but Widget (Mutable, Map Cursor childModel)?+  Then, you can adapt the real model to that tuple.+  This is probably less convenient than what I have now++* Can I create a generic newDelegate method in FocusDelegator instead+  of copying it into each widget?  Its probably possible by using ugly+  accessors/adapters, but less important at the moment.
+ lui.cabal view
@@ -0,0 +1,51 @@+Name:                lui+Version:             0.0.1+Cabal-Version:       >= 1.2+Synopsis:            Purely FunctionaL User Interface+Category:            graphics+Description:+  This package contains a set of composable purely functional widgets+  and a mainloop adapter to adapt the widgets to run in IO. It is+  HaskGame based.+  .+  HaskGame does not yet wrap SDL properly, so it uses SDL directly as+  well.+  .+  Project wiki page: <http://haskell.org/haskellwiki/LUI>+  .+  &#169; 2009 by Eyal Lotem; BSD3 license.++Author:              Eyal Lotem+Maintainer:          eyal.lotem@gmail.com+--Homepage:            http://haskell.org/haskellwiki/LUI+--Package-Url:         http://code.haskell.org/LUI+Copyright:           (c) 2008 by Eyal Lotem+License:             BSD3+Stability:           experimental+build-type:          Simple++Library+  hs-Source-Dirs:      src+  Extensions:+  Build-Depends:       base, haskell98, containers, mtl, SDL, haskgame+  Exposed-Modules:     Graphics.UI.LUI.Accessor,+                       Graphics.UI.LUI.Draw,+                       Graphics.UI.LUI.Run,+                       Graphics.UI.LUI.Widget,+                       Graphics.UI.LUI.Widgets.Adapter,+                       Graphics.UI.LUI.Widgets.Box,+                       Graphics.UI.LUI.Widgets.FocusDelegator,+                       Graphics.UI.LUI.Widgets.Grid,+                       Graphics.UI.LUI.Widgets.KeysTable,+                       Graphics.UI.LUI.Widgets.Space,+                       Graphics.UI.LUI.Widgets.TextEdit,+                       Graphics.UI.LUI.Widgets.TextView,+                       Graphics.UI.LUI.Widgets.Unfocusable+  Other-Modules:       Example,+                       Graphics.UI.LUI.Func,+                       Graphics.UI.LUI.List,+                       Graphics.UI.LUI.Tuple++  ghc-options:         -Wall++--  ghc-prof-options:    -prof -auto-all
+ src/Example.hs view
@@ -0,0 +1,159 @@+{-# OPTIONS_GHC -Wall -O2+ #-}++module Example(main) where++import qualified Graphics.UI.LUI.Run as Run+import qualified Graphics.UI.LUI.Widgets.TextEdit as TextEdit+import qualified Graphics.UI.LUI.Widgets.TextView as TextView+import qualified Graphics.UI.LUI.Widgets.Grid as Grid+import qualified Graphics.UI.LUI.Widgets.Box as Box+import qualified Graphics.UI.LUI.Widgets.Space as Space+import qualified Graphics.UI.LUI.Widgets.KeysTable as KeysTable+import Graphics.UI.LUI.Widget(Widget)+import Graphics.UI.LUI.Accessor(Accessor, accessor, aMapValue, (^>), (^.))++import qualified Graphics.UI.HaskGame.Font as Font+import qualified Graphics.UI.HaskGame as HaskGame+import Graphics.UI.HaskGame.Font(Font)+import Graphics.UI.HaskGame.Color(Color(..))++import qualified Data.Map as Map+import Data.Maybe(listToMaybe)+import Control.Monad(mapM)++isSorted :: (Ord a) => [a] -> Bool+isSorted xs = and $ zipWith (<=) xs (tail xs)++main :: IO ()+main = HaskGame.withInit $ do+    gui <- makeGui+    Run.mainLoop gui guiModel+    return ()++-- Model:+data Model = Model+    {+      vboxModel :: Box.DelegatedMutable+    , hboxModel :: Box.Mutable+    , textEditModels :: Map.Map Grid.Cursor TextEdit.DelegatedMutable+    , gridModel :: Grid.DelegatedMutable+    }++data Fonts = Fonts+    {+      defaultFont, textViewFont, keysFont, descFont :: Font+    }++-- TODO: Replace with TH auto-gen+avboxModel :: Accessor Model Box.DelegatedMutable+avboxModel = accessor vboxModel (\new x -> x{vboxModel=new})+ahboxModel :: Accessor Model Box.Mutable+ahboxModel = accessor hboxModel (\new x -> x{hboxModel=new})+atextEditModels :: Accessor Model (Map.Map Grid.Cursor TextEdit.DelegatedMutable)+atextEditModels = accessor textEditModels (\new x -> x{textEditModels=new})+agridModel :: Accessor Model Grid.DelegatedMutable+agridModel = accessor gridModel (\new x -> x{gridModel=new})++texts :: [String]+texts =+    [+     "Hello"+    ,"World"+    ,"Blah"+    ,"Bleh"+    ]++guiModel :: Model+guiModel =+    Model+    {+      vboxModel = Box.delegatedMutable False 0+    , hboxModel = Box.Mutable 0+    , textEditModels =+      Map.fromList [((x, y),+                     TextEdit.delegatedMutable False (texts!!(y*2+x)) 5)+                    | x <- [0..1]+                   , y <- [0..1]]+    , gridModel = Grid.delegatedMutable False (0, 0)+    }+++-- Widgets++textEditCursorColor, textViewColor, textEditColor, textEditingColor :: Color+textEditingColor = Color 30 20 100+textEditColor = Color 255 255 255+textViewColor = Color 255 100 255+textEditCursorColor = Color 255 0 0++textEdit :: Grid.Cursor -> Fonts -> Widget Model+textEdit cursor fonts =+    TextEdit.newDelegated textEditingColor+                          textEditCursorColor+                          (defaultFont fonts)+                          textEditColor $+                          atextEditModels ^> aMapValue cursor+                          ++textView :: String -> Fonts -> Widget Model+textView text fonts =+    TextView.new textViewColor (textViewFont fonts) text++grid, hbox, vbox, keysTable, proxy1, proxy2 :: Fonts -> Widget Model++gridSize :: Grid.Cursor+gridSize = (2, 2)++grid fonts =+    Grid.newDelegated gridSize items agridModel+    where+      items = Map.fromList+              [((x, y), Grid.Item (textEdit (x, y) fonts) (0.5, 1))+               | x <- [0..1], y <- [0..1]]++hbox fonts =+    Box.new Box.Horizontal items ahboxModel+    where+      items = [Box.Item (vbox fonts) 0.5+              ,Box.Item (Space.newW 50) 0+              ,Box.Item (keysTable fonts) 0]++vbox fonts = Box.newDelegated Box.Vertical items avboxModel+    where+      items = [Box.Item (grid fonts) 1+              ,Box.Item (Space.newH 100) 0.5+              ,Box.Item (proxy1 fonts) 0.5+              ,Box.Item (textView "This is just a view" fonts) 0.5+              ,Box.Item (proxy2 fonts) 0.5]++keysTable fonts = KeysTable.newForWidget (keysFont fonts) (descFont fonts) (hbox fonts)++proxy1 fonts model =+    textEdit (model ^. agridModel ^. Grid.aDelegatedMutableCursor) fonts model++simpleRead :: Read a => String -> Maybe a+simpleRead = listToMaybe . map fst . filter (null . snd) . reads++readCursor :: String -> Maybe Grid.Cursor+readCursor text =+    let (xCount, yCount) = gridSize+        verifyCursor cursor@(x, y) =+            if isSorted [0, x, xCount-1] &&+               isSorted [0, y, yCount-1]+            then Just cursor+            else Nothing+    in verifyCursor =<< simpleRead text++proxy2 fonts model =+    let cursor = model ^. agridModel ^. Grid.aDelegatedMutableCursor+        text = model ^. atextEditModels ^. aMapValue cursor ^.+               TextEdit.aDelegatedMutableText+    in maybe (textView ("Invalid cursor position selected: " ++ text) fonts model)+             (\cur -> textEdit cur fonts model) $+       readCursor text++makeGui :: IO (Widget Model)+makeGui = do+  [f15, f25, f30] <- mapM Font.defaultFont [15, 25, 30]+  return . hbox $ Fonts f30 f15 f25 f25
+ src/Graphics/UI/LUI/Accessor.hs view
@@ -0,0 +1,83 @@+{-# OPTIONS_GHC -Wall -O2+ #-}++-- TODO: Put this in a more generic library++module Graphics.UI.LUI.Accessor+    (Accessor,accessor,convertor+    -- getter/setter+    ,(^.),(^:)+    -- composition+    ,(<^),(^>)+    -- Accessors+    ,self,null,reader+    ,write+    -- Tuple+    ,afirst,asecond+    -- List+    ,anth+    -- Data.Map+    ,aMapValue+    ,aMapValueDefault) where++import Graphics.UI.LUI.List(nth)++import Control.Arrow(first, second)+import qualified Data.Map as Map+import Data.Map(Map)++data Accessor whole part =+    Accessor+    {+      accessorGet :: whole -> part+    , accessorSet :: part -> whole -> whole+    }++accessor :: (whole -> part) ->+            (part -> whole -> whole) ->+            Accessor whole part+accessor = Accessor++-- If you can create a whole from a part, then its really a convertor:+convertor :: (whole -> part) -> (part -> whole) ->+             Accessor whole part+convertor extract build = accessor extract (const . build)++self :: Accessor a a+self = accessor id const++reader :: r -> Accessor a r+reader x = accessor (const x) (const id)++write :: Accessor whole part -> part -> whole -> whole+write = accessorSet++(^.) :: whole -> Accessor whole part -> part+(^.) = flip accessorGet++(^:) :: Accessor whole part -> (part -> part) -> whole -> whole+(acc ^: modifyPart) whole = accessorSet acc+                            (modifyPart (whole ^. acc)) whole++(^>) :: Accessor a b -> Accessor b c -> Accessor a c+x ^> y = accessor (accessorGet y . accessorGet x)+                  ((x ^:) . accessorSet y)++(<^) :: Accessor b c -> Accessor a b -> Accessor a c+(<^) = flip (^>)++afirst :: Accessor (a, b) a+afirst = accessor fst (first . const)+asecond :: Accessor (a, b) b+asecond = accessor snd (second . const)++anth :: Int -> Accessor [a] a+anth n = accessor (!!n) (nth n . const)++aMapValue :: Ord k => k -> Accessor (Map k a) a+aMapValue key = accessor (Map.! key) setValue+    where+      setValue value = Map.adjust (const value) key++aMapValueDefault :: Ord k => a -> k -> Accessor (Map k a) a+aMapValueDefault def key = accessor (Map.findWithDefault def key) (Map.insert key)
+ src/Graphics/UI/LUI/Draw.hs view
@@ -0,0 +1,85 @@+{-# OPTIONS -Wall -O2+  -XGeneralizedNewtypeDeriving+  #-}++module Graphics.UI.LUI.Draw+    (Position,Size+    -- The monads+    ,Draw+    ,Compute+    -- Monad runners+    ,render+    ,computeResult+    -- Compute primitives+    ,textSize+    -- Draw primitives+    ,computeToDraw+    ,text+    ,rect+    ,move+    ) where++import qualified Graphics.UI.HaskGame as HaskGame+import qualified Graphics.UI.HaskGame.Font as Font+import qualified Graphics.UI.HaskGame.Rect as Rect+import Graphics.UI.HaskGame.Vector2(Vector2(..))+import Graphics.UI.HaskGame.Color(Color)+import Graphics.UI.HaskGame.Font(Font)++import Control.Monad.Trans(lift)+import Control.Monad.Reader(ReaderT, ask, local, runReaderT)++type Position = Vector2 Int+type Size = Vector2 Int++newtype Compute a = Compute { unCompute :: IO a }+    deriving Monad+liftIO :: IO a -> Compute a+liftIO = Compute++-- Monad Transformers require a bit of boiler-plate...+newtype Draw a = Draw { unDraw :: ReaderT HaskGame.Surface (ReaderT Position Compute) a }+    deriving Monad+liftPosition :: ReaderT Position Compute a -> Draw a+liftPosition = Draw . lift+liftSurface :: ReaderT HaskGame.Surface (ReaderT Position Compute) a -> Draw a+liftSurface = Draw++computeToDraw :: Compute a -> Draw a+computeToDraw = Draw . lift . lift++computeResult :: Compute a -> IO a+computeResult = unCompute++render :: HaskGame.Surface -> Position -> Draw a -> IO a+render surface pos = computeResult .+                     flip runReaderT pos .+                     flip runReaderT surface .+                     unDraw++textSize :: Font -> String -> Compute Size+textSize font str = do+  liftIO $ Font.textSize font str++text :: Color -> Font -> String -> Draw Size+text color font str = do+  surface <- liftSurface ask+  position <- liftPosition ask+  computeToDraw $ do+    textSurface <- liftIO $ Font.renderText font str color+    liftIO $ HaskGame.blit surface position textSurface+    textSize font str+  +rect :: Color -> Size -> Draw Size+rect color size = do+  surface <- liftSurface $ ask+  position <- liftPosition ask+  let r = Rect.makeRect position size+  computeToDraw . liftIO $ HaskGame.fillRect surface r color+  return size++move :: Position -> Draw a -> Draw a+move delta (Draw act) = do+  surface <- liftSurface $ ask+  let posReaderT = flip runReaderT surface act+  liftPosition $ local (+delta) posReaderT
+ src/Graphics/UI/LUI/Func.hs view
@@ -0,0 +1,18 @@+{-# OPTIONS_GHC -Wall -O2+  #-}++module Graphics.UI.LUI.Func(result, argument, (~>)) where++-- TODO: Put this in a more generic library++import Control.Arrow(Arrow, (<<<), (>>>))++result :: Arrow arr => arr b c -> arr a b -> arr a c+result = (<<<)++argument :: Arrow arr => arr a b -> arr b c -> arr a c+argument = (>>>)++infixr 2 ~>+(~>) :: (Arrow arr) => arr a b -> arr c d -> arr b c -> arr a d+(arg ~> res) func = arg >>> func >>> res
+ src/Graphics/UI/LUI/List.hs view
@@ -0,0 +1,15 @@+{-# OPTIONS_GHC -Wall -O2+  #-}++-- TODO: Put this in a more generic library++module Graphics.UI.LUI.List(isSorted, nth) where+    isSorted :: (Ord a) => [a] -> Bool+    isSorted xs = and $ zipWith (<=) xs (tail xs)++    -- Semantic editor combinator, like "first" or "second", but for+    -- an index in a list+    nth :: Int -> (a -> a) -> [a] -> [a]+    nth _ _    [] = error "nth index out of range"+    nth 0 func (x:xs) = func x:xs+    nth n func (x:xs) = x:nth (n-1) func xs
+ src/Graphics/UI/LUI/Run.hs view
@@ -0,0 +1,82 @@+{-# OPTIONS_GHC -Wall -O2+ #-}++module Graphics.UI.LUI.Run(mainLoop)+where++import qualified Graphics.UI.LUI.Draw as Draw+import qualified Graphics.UI.LUI.Widget as Widget+import Graphics.UI.LUI.Widget(Widget, WidgetFuncs(..))++import qualified Graphics.UI.SDL as SDL+import qualified Graphics.UI.HaskGame as HaskGame+import qualified Graphics.UI.HaskGame.Key as Key+import qualified Graphics.UI.HaskGame.Keys as Keys+import Graphics.UI.HaskGame.Vector2(Vector2(..))+import Graphics.UI.HaskGame.Color(Color(..))++import qualified Control.Monad.State as State+import qualified Data.Map as Map+import Control.Monad(forM, forM_, msum)+import Control.Monad.Trans(lift)++-- Commented out for 6.8's lack of the new Exception+-- import qualified Control.Exception as Exc+-- import Data.Typeable(Typeable)++-- Commented out for 6.8's lack of the new Exception+-- data QuitRequest = QuitRequest+--   deriving (Typeable, Show)+-- instance Exc.Exception QuitRequest where++handleKeyAction :: WidgetFuncs model ->+                   Widget.KeyStatus -> Key.Keysym -> Maybe model+handleKeyAction widgetFuncs keyStatus keySym =+  let key = Key.keyOfEvent keySym+      keyGroups = Keys.groupsOfKey key+      mKeyHandler = msum $ map lookupGroup keyGroups+      lookupGroup keyGroup = Map.lookup (keyStatus, keyGroup) =<<+                             widgetGetKeymap widgetFuncs+      runHandler (_, func) = func key+  in fmap runHandler mKeyHandler++handleEvents :: [HaskGame.Event] -> Widget model ->+                State.StateT model IO Bool+handleEvents events widget =+  fmap or $ forM events $ \event -> do+    model <- State.get+    let mNewModel = case event of+                      -- 6.8 exceptions :-(+                      -- lift $ Exc.throwIO QuitRequest+                      SDL.Quit -> error "Quit"+                      SDL.KeyDown k -> handleKeyAction (widget model) Widget.KeyDown k+                      SDL.KeyUp k -> handleKeyAction (widget model) Widget.KeyUp k+                      _ -> Nothing+    case mNewModel of+      Nothing ->+          return False+      Just newState -> do+          State.put newState+          return True++-- TODO: Must return the new model+mainLoop :: Widget model -> model -> IO model+mainLoop widget initModel = do+  display <- HaskGame.setVideoMode 800 600 16+  (`State.execStateT` initModel) $+    forM_ (True:repeat False) $ \shouldDraw -> do+      events <- lift $ HaskGame.getEvents+      handledEvent <- handleEvents events widget+      model <- State.get+      lift $ do+        HaskGame.fillSurface display (Color 0 0 0)+        if handledEvent || shouldDraw+          then do+            -- forM_ (Map.assocs $ fromMaybe Map.empty $ Widget.getKeymap widget model) $+            --   \((_, group), (desc, _)) -> do+            --     print (MySDLKey.keyGroupName group, desc)+            let draw = widgetDraw (widget model) (Widget.DrawInfo True)+            Draw.render display (Vector2 0 0) draw+            SDL.flip display+          else+            SDL.delay 20
+ src/Graphics/UI/LUI/Tuple.hs view
@@ -0,0 +1,8 @@+{-# OPTIONS_GHC -Wall -O2+  #-}++-- TODO: Put this in a more generic library++module Graphics.UI.LUI.Tuple(swap) where+    swap :: (a, b) -> (b, a)+    swap (x, y) = (y, x)
+ src/Graphics/UI/LUI/Widget.hs view
@@ -0,0 +1,47 @@+{-# OPTIONS_GHC -Wall -O2+  #-}++module Graphics.UI.LUI.Widget+    (DrawInfo(..)+    ,WidgetFuncs(..)+    ,KeyStatus(..)+    ,Widget+    ,New+    ,KeyAction+    ,Handler+    ,ActionHandlers+    )+where++import Graphics.UI.LUI.Draw(Draw, Compute, Size)+import Graphics.UI.LUI.Accessor(Accessor)++import qualified Graphics.UI.HaskGame.Key as Key++import qualified Data.Map as Map++data KeyStatus = KeyDown | KeyUp+  deriving (Eq, Ord, Show, Read)++type KeyAction = (KeyStatus, Key.KeyGroup)+type Handler model = (String, Key.ModKey -> model)+type ActionHandlers model = Map.Map KeyAction (Handler model)++data DrawInfo = DrawInfo+    {+      diHasFocus :: Bool+    }+  deriving (Eq, Ord, Show, Read)++-- TODO: Consider moving the model argument outside of the record+data WidgetFuncs model = WidgetFuncs+    {+      widgetDraw :: DrawInfo -> Draw Size+    , widgetSize :: DrawInfo -> Compute Size+    , widgetGetKeymap :: Maybe (ActionHandlers model)+    }++type Widget model = model -> WidgetFuncs model++type New model mutable =+    Accessor model mutable -> Widget model
+ src/Graphics/UI/LUI/Widgets/Adapter.hs view
@@ -0,0 +1,27 @@+{-# OPTIONS_GHC -Wall -O2+  #-}++module Graphics.UI.LUI.Widgets.Adapter(adapt) where++import qualified Graphics.UI.LUI.Widget as Widget+import Graphics.UI.LUI.Widget(Widget, WidgetFuncs(..))++import Graphics.UI.LUI.Func(result)+import Graphics.UI.LUI.Accessor(Accessor, write, (^.))++import qualified Data.Map as Map+import Control.Arrow(second)++adapt :: Accessor whole part -> Widget part -> Widget whole+adapt acc widget model =+    let widgetFuncs = widget (model ^. acc)+    in+      WidgetFuncs+      {+        widgetDraw = widgetDraw widgetFuncs+      , widgetSize = widgetSize widgetFuncs+      , widgetGetKeymap =+          let keymap = widgetGetKeymap widgetFuncs+              convertModel part = write acc part model+          in (fmap . Map.map . second . result) convertModel $ keymap+      }
+ src/Graphics/UI/LUI/Widgets/Box.hs view
@@ -0,0 +1,82 @@+{-# OPTIONS_GHC -Wall -O2+  #-}++module Graphics.UI.LUI.Widgets.Box+    (Orientation(..)+    ,Item(..)+    ,Mutable(..)+    ,Cursor+    ,new+    ,aMutableCursor+    ,DelegatedMutable+    ,delegatedMutable+    ,aDelegatedMutableCursor+    ,newDelegated+    ,newDelegatedWith+    ) where++import qualified Graphics.UI.LUI.Widget as Widget+import qualified Graphics.UI.LUI.Widgets.Grid as Grid+import qualified Graphics.UI.LUI.Widgets.FocusDelegator as FocusDelegator+import Graphics.UI.LUI.Widget(Widget)+import Graphics.UI.LUI.Tuple(swap)+import Graphics.UI.LUI.Accessor(Accessor, convertor, (^>))++import Graphics.UI.HaskGame.Color(Color(..))++import qualified Data.Map as Map++data Orientation = Horizontal | Vertical++data Item model = Item+    {+      itemChildWidget :: Widget model++    -- See comment about Grid.Item alignments+    , itemAlignment :: Double+    }++type Cursor = Int++data Mutable = Mutable+    {+      mutableCursor :: Cursor+    }+-- TODO: Auto-TH for this+aMutableCursor :: Accessor Mutable Cursor+aMutableCursor = convertor mutableCursor Mutable++new :: Orientation -> [Item model] -> Widget.New model Mutable+new orientation items acc =+    Grid.new gridSize gridItems $ acc ^> boxGridConvertor+    where+      gridSize = (maybeSwap (1, length items))+      gridItems = (Map.fromList $+                   [(maybeSwap (0, i),+                     Grid.Item childWidget . maybeSwap $ (0, alignment))+                    | (i, Item childWidget alignment) <- zip [0..] items])+      maybeSwap = case orientation of+                    Vertical -> id+                    Horizontal -> swap+      boxGridConvertor = convertor mutableToGridMutable gridMutableToMutable+      mutableToGridMutable = Grid.Mutable . maybeSwap . (,) 0 . mutableCursor+      gridMutableToMutable = Mutable . snd . maybeSwap . Grid.mutableCursor++type DelegatedMutable = FocusDelegator.DelegatedMutable Mutable++aDelegatedMutableCursor :: Accessor DelegatedMutable Cursor+aDelegatedMutableCursor = FocusDelegator.aDelegatedMutable ^> aMutableCursor++delegatedMutable :: Bool -> Cursor -> DelegatedMutable+delegatedMutable startInside cursor =+    (FocusDelegator.Mutable startInside, Mutable cursor)++newDelegatedWith :: Color -> Orientation -> [Item model] ->+                    Widget.New model DelegatedMutable+newDelegatedWith focusColor orientation items acc =+    let box = new orientation items $ acc ^> FocusDelegator.aDelegatedMutable+    in FocusDelegator.newWith focusColor "Go in" "Go out" box $+       acc ^> FocusDelegator.aFocusDelegatorMutable++newDelegated :: Orientation -> [Item model] -> Widget.New model DelegatedMutable+newDelegated = newDelegatedWith FocusDelegator.defaultFocusColor
+ src/Graphics/UI/LUI/Widgets/FocusDelegator.hs view
@@ -0,0 +1,98 @@+{-# OPTIONS_GHC -Wall -O2+  #-}++module Graphics.UI.LUI.Widgets.FocusDelegator+    (Mutable(..)+    ,DelegatedMutable+    ,aDelegatedMutable+    ,aFocusDelegatorMutable+    ,defaultFocusColor+    ,newWith+    ,new+    )+where++import qualified Graphics.UI.LUI.Widget as Widget+import qualified Graphics.UI.LUI.Draw as Draw+import Graphics.UI.LUI.Widget(Widget, WidgetFuncs(..))++import Graphics.UI.LUI.Func(result)+import Graphics.UI.LUI.Accessor(Accessor, afirst, asecond, (^.), write)++import qualified Graphics.UI.SDL as SDL+import qualified Graphics.UI.HaskGame.Key as Key+import Graphics.UI.HaskGame.Key(asKeyGroup, noMods)+import Graphics.UI.HaskGame.Color(Color(..))++import qualified Data.Map as Map+import Control.Arrow(second)+import Data.Maybe(fromMaybe)++-- TODO: Use record instead of tuple so auto-TH creates the accessors:+type DelegatedMutable mutable = (Mutable, mutable)+aDelegatedMutable :: Accessor (DelegatedMutable mutable) mutable+aDelegatedMutable = asecond+aFocusDelegatorMutable :: Accessor (DelegatedMutable mutable) Mutable+aFocusDelegatorMutable = afirst++-- defaults:+defaultFocusColor :: Color+defaultFocusColor = Color 0 0 150++data Mutable = Mutable+    {+      mutableDelegateFocus :: Bool+    }++buildKeymap :: SDL.SDLKey -> String -> Bool -> Widget.ActionHandlers Mutable+buildKeymap key desc newDelegating =+    Map.singleton (Widget.KeyDown, asKeyGroup noMods key)+                  (desc, const $ Mutable newDelegating)++delegatingKeyMap, nonDelegatingKeyMap ::+    String -> Widget.ActionHandlers Mutable+nonDelegatingKeyMap startStr = buildKeymap SDL.SDLK_RETURN startStr True+delegatingKeyMap    stopStr  = buildKeymap SDL.SDLK_ESCAPE stopStr False++newWith :: Color -> String -> String -> Widget model -> Widget.New model Mutable+newWith focusColor startStr stopStr childWidget acc model =+    let Mutable delegating = model ^. acc+        childWidgetFuncs = childWidget model+    in WidgetFuncs+    {+      widgetSize = \drawInfo -> widgetSize childWidgetFuncs drawInfo+    , widgetDraw = \drawInfo -> do+        let +            haveFocus = Widget.diHasFocus drawInfo+            delegatorHasFocus = haveFocus && not delegating+            childDrawInfo = Widget.DrawInfo+                            {+                              Widget.diHasFocus = haveFocus && delegating+                            }+        if delegatorHasFocus+          then do+            size <- Draw.computeToDraw $+                    widgetSize childWidgetFuncs childDrawInfo+            Draw.rect focusColor size+            return ()+          else+            return ()+        widgetDraw childWidgetFuncs childDrawInfo+    , widgetGetKeymap =+        let mChildKeymap = widgetGetKeymap childWidgetFuncs+            childKeymap = fromMaybe Map.empty mChildKeymap+            applyToModel newMutable = acc `write` newMutable $ model+            wrapKeymap = (Map.map . second . result) applyToModel+        in case delegating of+             True ->+                 Just $+                 childKeymap `Map.union` (wrapKeymap $ delegatingKeyMap stopStr)+             False ->+                 const (wrapKeymap $ nonDelegatingKeyMap startStr)+                 -- Only expose the nonDelegatingKeyMap if the child+                 -- has a keymap:+                 `fmap` mChildKeymap+    }++new :: String -> String -> Widget model -> Widget.New model Mutable+new = newWith defaultFocusColor
+ src/Graphics/UI/LUI/Widgets/Grid.hs view
@@ -0,0 +1,230 @@+{-# OPTIONS_GHC -Wall -O2+  #-}++module Graphics.UI.LUI.Widgets.Grid+    (Item(..)+    ,Mutable(..)+    ,Items+    ,Cursor+    ,new+    ,aMutableCursor+    ,DelegatedMutable+    ,delegatedMutable+    ,aDelegatedMutableCursor+    ,newDelegated+    ,newDelegatedWith+    )+where++import qualified Graphics.UI.LUI.Widget as Widget+import qualified Graphics.UI.LUI.Widgets.FocusDelegator as FocusDelegator+import qualified Graphics.UI.LUI.Draw as Draw++import Graphics.UI.LUI.Widget(Widget, WidgetFuncs(..))++import Graphics.UI.LUI.Func((~>), result)+import Graphics.UI.LUI.List(isSorted)+import Graphics.UI.LUI.Tuple(swap)+import Graphics.UI.LUI.Accessor(Accessor, convertor, (^.), (^>), write)++import qualified Graphics.UI.SDL as SDL+import qualified Graphics.UI.HaskGame.Key as Key+import Graphics.UI.HaskGame.Key(asKeyGroup, noMods, shift)+import Graphics.UI.HaskGame.Color(Color)+import Graphics.UI.HaskGame.Vector2(Vector2(..)+                                   ,vector2fst,vector2snd)++import qualified Data.Map as Map+import Control.Monad(forM_, forM)+import Control.Arrow(second, (***))+import Data.List(transpose)+import Data.Maybe(isJust, fromMaybe)+import Data.Maybe(isNothing)++data Item model = Item+    {+      itemWidget :: Widget model++      -- alignments are a number between 0..1 that+      -- represents where in the grid item's left..right+      -- and top..down the item should be in+    , itemAlignments :: (Double, Double)+    }++type Items model = Map.Map Cursor (Item model)+type Cursor = (Int, Int)++data Mutable = Mutable+    {+      mutableCursor :: Cursor+    }+-- TODO: Auto-TH for this+aMutableCursor :: Accessor Mutable Cursor+aMutableCursor = convertor mutableCursor Mutable++selectedItem :: Mutable -> Items model -> Maybe (Item model)+selectedItem (Mutable cursor) items = cursor `Map.lookup` items++gridRows :: Cursor -> Items model -> [[(Cursor, Maybe (Item model))]]+gridRows (sizex, sizey) items =+    [[((x,y), (x,y) `Map.lookup` items) | x <- [0..sizex-1]] | y <- [0..sizey-1]]++gridDrawInfo :: Mutable -> Cursor -> Widget.DrawInfo -> Widget.DrawInfo+gridDrawInfo (Mutable cursor) itemIndex (Widget.DrawInfo drawInfo) =+    Widget.DrawInfo (drawInfo && cursor==itemIndex)++getRowColumnSizes :: model -> Mutable -> Items model -> Cursor -> Widget.DrawInfo ->+                     Draw.Compute ([Int], [Int])+getRowColumnSizes model mutable items size drawInfo = do+  rowsSizes <- forM (gridRows size items) . mapM $ \(itemIndex, mItem) ->+                   case mItem of+                     Nothing -> return $ Vector2 0 0+                     Just item ->+                         widgetSize ((itemWidget item) model)+                                    (gridDrawInfo mutable itemIndex drawInfo)++  let rowsHeights = (map . map) vector2snd rowsSizes+      rowsWidths = (map . map) vector2fst rowsSizes+      rowHeights = map maximum $ rowsHeights+      columnWidths = map maximum . transpose $ rowsWidths+  return (rowHeights, columnWidths)++mutableCursorApply :: (Cursor -> Cursor) -> Mutable -> Mutable+mutableCursorApply func (Mutable oldCursor) = Mutable $ func oldCursor++mutableMoveTo :: (Int, Int) -> Mutable -> Mutable+mutableMoveTo newCursor = mutableCursorApply (const newCursor)++itemSelectable :: model -> Item model -> Bool+itemSelectable model (Item widget _) =+    isJust . widgetGetKeymap $ widget model++getSelectables :: ((Int, Int) -> (Int, Int)) ->+                  (Int -> Int) ->+                  Cursor -> model -> Mutable -> Items model ->+                  [(Int, Int)]+getSelectables toSwap cursorFunc size model (Mutable oldCursor) items =+    let (sizeA,_) = toSwap size+        (oldA,b) = toSwap oldCursor+        nexts = takeWhile (\a -> isSorted [0, a, sizeA-1]) .+                iterate cursorFunc $ oldA+        coor a = toSwap (a, b)+        itemAt a = (coor a, items Map.! coor a)+    in map fst . filter (itemSelectable model . snd) . map itemAt . drop 1 $ nexts++getSelectablesX, getSelectablesY :: (Int -> Int) ->+                                    Cursor -> model -> Mutable -> Items model ->+                                    [(Int, Int)]+getSelectablesX = getSelectables id+getSelectablesY = getSelectables swap++getSelectablesXY :: [Int] -> (Int -> Int) ->+                    Cursor -> model -> Mutable -> Items model ->+                    [(Int, Int)]+getSelectablesXY xrange cursorFunc size model (Mutable oldCursor) items =+    let (sizeX,sizeY) = size+        (oldX,oldY) = oldCursor+        xnexts = drop 1 . takeWhile (\x -> isSorted [0, x, sizeX-1]) .+                 iterate cursorFunc $ oldX+        ynexts = drop 1 . takeWhile (\y -> isSorted [0, y, sizeY-1]) .+                 iterate cursorFunc $ oldY+        nexts = map (flip (,) oldY) xnexts +++                [(x, y) | y <- ynexts, x <- xrange]+        itemAt cursor = (cursor, items Map.! cursor)+    in map fst . filter (itemSelectable model . snd) . map itemAt $ nexts++keysMap :: Cursor -> model -> Mutable -> Items model -> Widget.ActionHandlers Mutable+keysMap size@(sizeX, _) model mutable items =+    Map.fromList $+       map (((,) Widget.KeyDown) ***+            second const) . concat $+           [let opts = axis size model mutable items+            in cond opts (key, (desc, head opts `mutableMoveTo` mutable))+            | (key, axis, desc) <-+                [(asKeyGroup noMods SDL.SDLK_LEFT,+                  getSelectablesX (subtract 1), "Move left")+                ,(asKeyGroup noMods SDL.SDLK_RIGHT,+                  getSelectablesX (+1), "Move right")+                ,(asKeyGroup noMods SDL.SDLK_UP,+                  getSelectablesY (subtract 1), "Move up")+                ,(asKeyGroup noMods SDL.SDLK_DOWN,+                  getSelectablesY (+1), "Move down")+                ,(asKeyGroup noMods SDL.SDLK_TAB,+                  getSelectablesXY [0..sizeX-1] (+1), "Move to next")+                ,(asKeyGroup shift SDL.SDLK_TAB,+                  getSelectablesXY [sizeX-1,sizeX-2..0] (subtract 1), "Move to prev")+                ]+           ]+    where+      cond p i = if not . null $ p then [i] else []++inFrac :: (Integral a, RealFrac b) => (b -> b) -> a -> a+inFrac = fromIntegral ~> floor++posSizes :: [Int] -> [(Int, Int)]+posSizes sizes =+    let positions = scanl (+) 0 sizes+    in zip positions sizes++new :: Cursor -> Items model -> Widget.New model Mutable+new size items acc model =+    let mutable = model ^. acc+        rows = gridRows size items+        rowColumnSizes drawInfo = getRowColumnSizes model mutable items size drawInfo+    in WidgetFuncs+    {+      widgetDraw = \drawInfo -> do+        (rowHeights, columnWidths) <- Draw.computeToDraw . rowColumnSizes $ drawInfo+        forM_ (zip (posSizes rowHeights) rows) $+          \((ypos, height), row) -> do+            forM_ (zip (posSizes columnWidths) row) $+              \((xpos, width), (itemIndex, mItem)) ->+                case mItem of+                  Nothing -> return ()+                  Just item -> do+                    let Item childWidget (ax, ay) = item+                        childDrawInfo = gridDrawInfo mutable itemIndex drawInfo+                        childWidgetFuncs = childWidget model+                    Vector2 w h <- Draw.computeToDraw $+                                   widgetSize childWidgetFuncs childDrawInfo+                    let pos = Vector2 (xpos + inFrac (*ax) (width-w))+                                      (ypos + inFrac (*ay) (height-h))+                    Draw.move pos $ widgetDraw childWidgetFuncs childDrawInfo+                    return ()+        return $ Vector2 (sum columnWidths) (sum rowHeights)++    , widgetSize = \drawInfo -> do+      (rowHeights, columnWidths) <- rowColumnSizes drawInfo+      return $ Vector2 (sum columnWidths) (sum rowHeights)++    , widgetGetKeymap =+      if all isNothing .+         map (widgetGetKeymap . ($model) . itemWidget) .+         Map.elems $ items+      then Nothing+      else Just $+        let childKeys = fromMaybe Map.empty $ do+                          Item childWidget _ <- selectedItem mutable items+                          widgetGetKeymap $ childWidget model+            applyToModel newMutable = acc `write` newMutable $ model+        in childKeys `Map.union` ((Map.map . second . result) applyToModel $+                                  keysMap size model mutable items)+    }++type DelegatedMutable = FocusDelegator.DelegatedMutable Mutable++aDelegatedMutableCursor :: Accessor DelegatedMutable Cursor+aDelegatedMutableCursor = FocusDelegator.aDelegatedMutable ^> aMutableCursor++delegatedMutable :: Bool -> Cursor -> DelegatedMutable+delegatedMutable startInside cursor =+    (FocusDelegator.Mutable startInside, Mutable cursor)++newDelegatedWith :: Color -> Cursor -> Items model -> Widget.New model DelegatedMutable+newDelegatedWith focusColor size items acc =+    let grid = new size items $ acc ^> FocusDelegator.aDelegatedMutable+    in FocusDelegator.newWith focusColor "Go in" "Go out" grid $+           acc ^> FocusDelegator.aFocusDelegatorMutable++newDelegated :: Cursor -> Items model -> Widget.New model DelegatedMutable+newDelegated = newDelegatedWith FocusDelegator.defaultFocusColor
+ src/Graphics/UI/LUI/Widgets/KeysTable.hs view
@@ -0,0 +1,70 @@+{-# OPTIONS_GHC -Wall -O2+  #-}++module Graphics.UI.LUI.Widgets.KeysTable+    (defaultKeysColor+    ,defaultDescColor+    ,defaultSpaceWidth+    ,new+    ,newForWidget+    )+where++import qualified Graphics.UI.LUI.Widget as Widget+import qualified Graphics.UI.LUI.Widgets.Grid as Grid+import qualified Graphics.UI.LUI.Widgets.TextView as TextView+import qualified Graphics.UI.LUI.Widgets.Unfocusable as Unfocusable+import qualified Graphics.UI.LUI.Widgets.Space as Space+import qualified Graphics.UI.HaskGame.Key as Key+import Graphics.UI.LUI.Widget(Widget, widgetGetKeymap)++import Graphics.UI.LUI.Accessor(reader)++import Graphics.UI.HaskGame.Color(Color(..))+import Graphics.UI.HaskGame.Font(Font)++import qualified Data.Map as Map+import Control.Arrow(first, second)+import Data.List(sort)+import Data.Maybe(fromMaybe)++-- Defaults:+defaultKeysColor, defaultDescColor :: Color+defaultKeysColor = Color 255 0 0+defaultDescColor = Color 0 0 255+defaultSpaceWidth :: Int+defaultSpaceWidth = 10++gItem :: Widget model -> Grid.Item model+gItem = flip Grid.Item (0, 0.5)++keyBindings :: Widget.ActionHandlers model -> [(Key.KeyGroup, String)]+keyBindings = sort .+              (map . first) snd .+              (map . second) fst .+              Map.assocs++new :: Color -> Color -> Int -> Font -> Font -> Widget.ActionHandlers model ->+       Widget model+new keysColor descColor spaceWidth keysFont descFont handlers = Unfocusable.new grid+    where+      grid = Grid.new (3, Map.size handlers) gridItems gridAccessor+      space = Space.newW spaceWidth+      gridItems =+          Map.fromList . concat $+          [[((0, y), gItem keyGroupTextView),+            ((1, y), gItem space),+            ((2, y), gItem descTextView)]+           | (y, (keyGroup, desc)) <- zip [0..] . keyBindings $ handlers+           , let keyGroupTextView =+                     TextView.new keysColor keysFont $ Key.keyGroupName keyGroup+                 descTextView =+                     TextView.new descColor descFont desc+          ]+      gridAccessor = reader $ Grid.Mutable (0,0)++newForWidget :: Font -> Font -> Widget model -> Widget model+newForWidget keysFont descFont widget model =+    let handlers = fromMaybe Map.empty . widgetGetKeymap $ widget model+    in new defaultKeysColor defaultDescColor defaultSpaceWidth+           keysFont descFont handlers model
+ src/Graphics/UI/LUI/Widgets/Space.hs view
@@ -0,0 +1,27 @@+{-# OPTIONS_GHC -Wall -O2+  #-}++module Graphics.UI.LUI.Widgets.Space(new, newWH, newW, newH)+where++import qualified Graphics.UI.LUI.Widget as Widget+import Graphics.UI.LUI.Widget(Widget, WidgetFuncs(..))+import Graphics.UI.LUI.Draw(Size)+import Graphics.UI.HaskGame.Vector2(Vector2(..))++new :: Size -> Widget model+new size =+    const $+    WidgetFuncs+    {+      widgetGetKeymap = Nothing+    , widgetDraw = \_ -> return size+    , widgetSize = \_ -> return size+    }++newWH :: Int -> Int -> Widget model+newWH w h = new $ Vector2 w h++newW, newH :: Int -> Widget model+newW w = newWH w 0+newH h = newWH 0 h
+ src/Graphics/UI/LUI/Widgets/TextEdit.hs view
@@ -0,0 +1,187 @@+{-# OPTIONS_GHC -Wall -O2+  #-}++module Graphics.UI.LUI.Widgets.TextEdit+    (Mutable(..)+    ,aMutableCursor+    ,aMutableText+    ,Cursor+    ,defaultCursorWidth+    ,new+    ,DelegatedMutable+    ,aDelegatedMutableCursor+    ,aDelegatedMutableText+    ,delegatedMutable+    ,newDelegatedWith+    ,newDelegated+    )+where++import qualified Graphics.UI.LUI.Widget as Widget+import qualified Graphics.UI.LUI.Draw as Draw+import qualified Graphics.UI.LUI.Widgets.FocusDelegator as FocusDelegator+import Graphics.UI.LUI.Widget(WidgetFuncs(..))++import Graphics.UI.LUI.Func(result)+import Graphics.UI.LUI.List(isSorted)+import Graphics.UI.LUI.Accessor(Accessor, accessor, (^.), (^>), write)++import qualified Graphics.UI.SDL as SDL+import qualified Graphics.UI.HaskGame.Key as Key+import qualified Graphics.UI.HaskGame.Keys as Keys+import Graphics.UI.HaskGame.Key(asKeyGroup, noMods, ctrl)+import Graphics.UI.HaskGame.Vector2(Vector2(..))+import Graphics.UI.HaskGame.Color(Color)+import Graphics.UI.HaskGame.Font(Font)++import qualified Data.Map as Map+import Data.Map((!))+import Control.Arrow(first, second)++type Cursor = Int++defaultCursorWidth :: Int+defaultCursorWidth = 2++data Mutable = Mutable+    {+      mutableText :: String+    , mutableCursor :: Cursor+    }+-- TODO: TH+aMutableCursor :: Accessor Mutable Cursor+aMutableCursor = accessor mutableCursor (\n x -> x{mutableCursor=n})+aMutableText :: Accessor Mutable String+aMutableText = accessor mutableText  (\n x -> x{mutableText=n})++insert :: Mutable -> Key.ModKey -> Mutable+insert (Mutable oldText oldCursor) key =+    let iText = Keys.keysUnicode!key+        (preOldText, postOldText) = splitAt oldCursor oldText+        newText = concat [preOldText, iText, postOldText]+        newCursor = oldCursor + length iText+    in Mutable newText newCursor++delBackward :: Int -> Mutable -> Mutable+delBackward count (Mutable oldText oldCursor) =+    let (oldPreText, oldPostText) = splitAt oldCursor oldText+        newPreText = take (length oldPreText - count) oldPreText+        newText = newPreText ++ oldPostText+        newCursor = length newPreText+    in Mutable newText newCursor++delForward :: Int -> Mutable -> Mutable+delForward count (Mutable oldText oldCursor) =+    let (oldPreText, oldPostText) = splitAt oldCursor oldText+        newPostText = drop count oldPostText+        newText = oldPreText ++ newPostText+    in Mutable newText oldCursor++moveCursor :: (Cursor -> Cursor) -> Mutable -> Mutable+moveCursor cursorFunc (Mutable text oldCursor) =+    let newCursor = cursorFunc oldCursor+    in Mutable text $ if isSorted [0, newCursor, length text]+                            then newCursor+                            else oldCursor++goHome :: Mutable -> Mutable+goHome (Mutable text _) = Mutable text 0++goEnd :: Mutable -> Mutable+goEnd (Mutable text _) = Mutable text (length text)++actBackspace, actDelete, actMovePrev, actMoveNext, actHome, actEnd ::+    (String, Mutable -> Mutable)++actBackspace = ("Delete previous character", delBackward 1)+actDelete = ("Delete next character",        delForward 1)+actMovePrev = ("Move to previous character", moveCursor (subtract 1))+actMoveNext = ("Move to next character",     moveCursor (+1))+actHome = ("Move to beginning of text",      goHome)+actEnd = ("Move to end of text",             goEnd)++keysMap :: Mutable -> Widget.ActionHandlers Mutable+keysMap mutable = Map.fromList . (map . first) ((,) Widget.KeyDown) $+    (Keys.printableGroup, ("Insert", insert mutable)) :+    (map . second . second) (const . ($mutable)) (normalActions mutable ++ ctrlActions mutable)++cond :: Bool -> [a] -> [a]+cond p i = if p then i else []++normalActions :: Mutable -> [(Key.KeyGroup, (String, Mutable -> Mutable))]+normalActions mutable =+    let cursor = mutableCursor mutable+        text = mutableText mutable+    in (map . first) (asKeyGroup noMods) . concat $+           [cond (cursor > 0)+                     [(SDL.SDLK_BACKSPACE, actBackspace)+                     ,(SDL.SDLK_LEFT, actMovePrev)+                     ,(SDL.SDLK_HOME, actHome)]+           ,cond (cursor < length text)+                     [(SDL.SDLK_DELETE, actDelete)+                     ,(SDL.SDLK_RIGHT, actMoveNext)+                     ,(SDL.SDLK_END, actEnd)]+           ]++ctrlActions :: Mutable -> [(Key.KeyGroup, (String, Mutable -> Mutable))]+ctrlActions mutable =+    let cursor = mutableCursor mutable+        text = mutableText mutable+    in (map . first) (asKeyGroup ctrl) . concat $+           [cond (cursor > 0)+                     [(SDL.SDLK_h, actBackspace)+                     ,(SDL.SDLK_a, actHome)]+           ,cond (cursor < length text)+                     [(SDL.SDLK_d, actDelete)+                     ,(SDL.SDLK_e, actEnd)]+           ]++new :: Int -> Color -> Color -> Font -> Color -> Widget.New model Mutable+new cursorWidth bgColor cursorColor font textColor acc model =+  let mutable@(Mutable text cursor) = model ^. acc+  in WidgetFuncs+  {+    widgetDraw = \drawInfo -> do+    +    if Widget.diHasFocus drawInfo+      then do+        textSize <- Draw.computeToDraw . Draw.textSize font $ text+        Vector2 w h <- Draw.computeToDraw . Draw.textSize font $ take cursor text+        let cursorSize = Vector2 cursorWidth h+            cursorPos = Vector2 w 0+        Draw.rect bgColor textSize+        Draw.text textColor font text+        Draw.move cursorPos $ Draw.rect cursorColor cursorSize+        return textSize+      else+        Draw.text textColor font text++  , widgetSize = \_ -> Draw.textSize font text++  , widgetGetKeymap =+    let applyToModel newMutable = acc `write` newMutable $ model+    in Just $+       (Map.map . second . result) applyToModel $ keysMap mutable+  }++type DelegatedMutable = FocusDelegator.DelegatedMutable Mutable++aDelegatedMutableCursor :: Accessor DelegatedMutable Cursor+aDelegatedMutableCursor = FocusDelegator.aDelegatedMutable ^> aMutableCursor+aDelegatedMutableText :: Accessor DelegatedMutable String+aDelegatedMutableText = FocusDelegator.aDelegatedMutable ^> aMutableText+delegatedMutable :: Bool -> String -> Cursor -> DelegatedMutable+delegatedMutable startInside text cursor =+    (FocusDelegator.Mutable startInside, Mutable text cursor)++newDelegatedWith :: Color -> Int -> Color -> Color -> Font -> Color ->+                    Widget.New model DelegatedMutable+newDelegatedWith focusColor cursorWidth bgColor cursorColor font textColor acc =+    let textEdit = new cursorWidth bgColor cursorColor font textColor $+                   acc ^> FocusDelegator.aDelegatedMutable+    in FocusDelegator.newWith focusColor "Start editing" "Stop editing" textEdit $+       acc ^> FocusDelegator.aFocusDelegatorMutable++newDelegated :: Color -> Color -> Font -> Color ->+                Widget.New model DelegatedMutable+newDelegated = newDelegatedWith FocusDelegator.defaultFocusColor defaultCursorWidth
+ src/Graphics/UI/LUI/Widgets/TextView.hs view
@@ -0,0 +1,22 @@+{-# OPTIONS_GHC -Wall -O2+  #-}++module Graphics.UI.LUI.Widgets.TextView(new)+where++import qualified Graphics.UI.LUI.Widget as Widget+import qualified Graphics.UI.LUI.Draw as Draw+import Graphics.UI.LUI.Widget(Widget, WidgetFuncs(..))++import Graphics.UI.HaskGame.Font(Font)+import Graphics.UI.HaskGame.Color(Color)++new :: Color -> Font -> String -> Widget model+new textColor textSize text =+    const $+    WidgetFuncs+    {+      widgetDraw = \_ -> Draw.text textColor textSize text+    , widgetSize = \_ -> Draw.textSize textSize text+    , widgetGetKeymap = Nothing+    }
+ src/Graphics/UI/LUI/Widgets/Unfocusable.hs view
@@ -0,0 +1,21 @@+{-# OPTIONS_GHC -Wall -O2+  #-}++module Graphics.UI.LUI.Widgets.Unfocusable(new)+where++import qualified Graphics.UI.LUI.Widget as Widget+import Graphics.UI.LUI.Widget(Widget, WidgetFuncs(..))++noFocusDrawInfo :: Widget.DrawInfo+noFocusDrawInfo = Widget.DrawInfo False++new :: Widget model -> Widget model+new childWidget model =+    let childWidgetFuncs = childWidget model+    in WidgetFuncs+    {+      widgetSize = \_ -> widgetSize childWidgetFuncs noFocusDrawInfo+    , widgetDraw = \_ -> widgetDraw childWidgetFuncs noFocusDrawInfo+    , widgetGetKeymap = Nothing+    }